Esope source files

   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 :