Télécharger la plaquette Cast3M


fr en

Télécharger g2po4c.eso

Retour à la liste

Numérotation des lignes : 

g2po4c

  1. C G2PO4C    SOURCE    CHAT      06/03/29    21:22:14     5360
  2. C
  3. C
  4.       SUBROUTINE G2PO4C(IC1,IC2,IC3,IC4,XYZ,
  5.      >                      NB1,NB2,IDIMC,COORD,NBN,iarr)
  6. C     **********************************************************************
  7. C     OBJET G2PO4C : CREATION DES POINTS D'UNE GRILLE A PARTIR DES 4 COTES
  8. C     OBJET          DU DOMAINE (INTERPOL. BILINEAIRE OU TRANSFINITE MAPPING)
  9. C
  10. C     EN ENTREE   :
  11. C         IC1,IC2,IC3,IC4 : LES POINTS DES COURBES FRONTIERES
  12. C         XYZ             : COORDONNEES DES POINTS DES COURBES FRONTIERES
  13. C         NB1 : NOMBRE DE NOEUDS DE IC1 ET IC3
  14. C         NB2 : NOMBRE DE NOEUDS DE IC2 ET IC4
  15. C
  16. C         IC1(1) EST LE NUMERO DU PREMIER POINT DONT LES COORDONNEES SONT
  17. C         XYZ(1)..XYZ(IDIMC). LE CONTOUR EST FERME => IC1(1) = IC4(NB2)
  18. C
  19. C     EN SORTIE   :
  20. C         COORD   : COORDONNEES DES POINTS CALCULES
  21. C         NBN     : NOMBRE DE POINTS (= NB1*NB2)
  22. C         iarr    : 0 SI OK, -1 SI LES DONNEES SONT ERRONEES
  23. C                   NOMBRE DE LIGNES OU DE COLONNES NEGATIF OU NUL
  24. C                   NOMBRE DE NOEUDS DIFFERENTS SUR LES COTES OPPOSES
  25. C
  26. C     REMARQUE    :
  27. C       L'ORDRE DES POINTS EST LE SUIVANT
  28. C       IC1(1)     ------------------- IC1(NB1)
  29. C       IC4(NB2-1) ------------------- IC2(2)
  30. C       IC4(NB2-2) ------------------- IC2(3)
  31. C                         ...
  32. C       IC4(2)     ------------------- IC2(NB2-1)
  33. C       IC2(NB2)   ------------------- IC2(1)
  34. C
  35. C     C.A.D. A COORD(1) = L'ABCISSE DE IC1(1),
  36. C            A COORD((NB1*NB2-1)*IDIMC+1) L'ABCISSE DE IC2(1)
  37. C     **********************************************************************
  38.       IMPLICIT INTEGER(I-N)
  39.       INTEGER IC1(*),IC2(*),IC3(*),IC4(*),NB1,NB2,IDIMC
  40.       REAL*8    XYZ(*),COORD(*)
  41.       INTEGER NBN,iarr
  42. C
  43.       INTEGER I,J,K
  44.       REAL*8    IU,IV,DU,DV
  45. C
  46.       iarr = -1
  47.       IF((NB1.LE.1).OR.(NB2.LE.1))GOTO 999
  48.       IF(IC1(1).NE.IC4(NB2))GOTO 999
  49.       IF(IC2(1).NE.IC1(NB1))GOTO 999
  50.       IF(IC3(1).NE.IC2(NB2))GOTO 999
  51.       IF(IC4(1).NE.IC3(NB1))GOTO 999
  52.       iarr = 0
  53.       DU = 1. / (NB1-1)
  54.       DV = 1. / (NB2-1)
  55.       DO 10 J = 2,NB2-1
  56.        IV = (J-1) * DV
  57.        DO 20 I = 2,NB1-1
  58.         IU = (I-1) * DU
  59.         NBN = NBN+1
  60.         DO 30 K=1,IDIMC
  61.          COORD((NBN-1)*IDIMC+K) =
  62.      >    ((1-IV) * XYZ((IC1(I)-1)*IDIMC+K)) +
  63.      >    ( IV    * XYZ((IC3(NB1-I+1)-1)*IDIMC+K)) +
  64.      >    ((1-IU) * XYZ((IC4(NB2-J+1)-1)*IDIMC+K)) +
  65.      >    ( IU    * XYZ((IC2(J)-1)*IDIMC+K)) -
  66.      >    ((1-IU) * (1-IV)* XYZ((IC4(NB2)-1)*IDIMC+K)) -
  67.      >    ((1-IU) * IV    * XYZ((IC3(NB1)-1)*IDIMC+K)) -
  68.      >    ((1-IV) * IU    * XYZ((IC1(NB1)-1)*IDIMC+K)) -
  69.      >    (  IU   * IV    * XYZ((IC2(NB2)-1)*IDIMC+K))
  70.    30   CONTINUE
  71.    20  CONTINUE
  72.    10 CONTINUE
  73. C
  74.   999 END
  75.  
  76.  
  77.  
  78.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales