1 : C G2LLG2 SOURCE CHAT 06/03/29 21:21:50 5360 2 : C 3 : C 4 : SUBROUTINE G2LLG2(IGR1,NBLIG1,NBCOL1, 5 : > IGR2,NBLIG2,NBCOL2, 6 : > COORD,NBCOOR,IDIMC,INDICE,RAPP, 7 : > ITVL,NITMAX, 8 : > IGRI,NBLIGI,NBCOLI,ITRACE,iarr) 9 : C ********************************************************************** 10 : C OBJET G2LLG2 : CREER UNE GRILLE INTERMEDIAIRE (ENTRE 2 GRILLES) 11 : C 12 : C EN ENTREE : 13 : C 14 : C IGR1(NBLIG1,NBCOL1) : LA PREMIERE GRILLE 15 : C IGR CONTIENT LES NUMEROS DES NOEUDS 16 : C IGR2(NBLIG2,NBCOL2) : LA DEUXIEME GRILLE 17 : C COORD,NBCOORD,IDIMC : POSITION DES NOEUDS 18 : C 19 : C RAPP : RAPPORT DES DISTANCES ENTRE LES GRILLES 20 : C (IGRI-IGR1) / (IGR2-IGR1) 21 : C 22 : C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS 23 : C NITMAX : TAILLE DE ITVL 24 : C ON A BESOIN DU TABLEAU DE TRAVAIL POUR COMPLETER IGR1 25 : C LA PLACE NECESSAIRE EST DE : NBCOL1*NBLIG2 26 : C 27 : C EN SORTIE : 28 : C 29 : C IGRI(NBLIGI,NBCOLI) : GRILLE SURFACIQUE INTERMEDIAIRE 30 : C NBLIGI = NBLIG2, NBCOLI = NBCOL1 31 : C 32 : C INDICE : DU DERNIER NOEUD CREE 33 : C 34 : C iarr : CODE D'ERREUR -1 SI DONNEES INCORRECTES 35 : C -2 SI TABLEAUX INSUFFISANTS 36 : C 37 : C REMARQUES : LES GRILLES IGR1 ET IGR2 SONT ORIENTEES DE LA MEME FACON 38 : C AVEC UNE ORIGINE COMPATIBLE (VOIR G2ORIG, G2ORIE) 39 : C AVEC NBCOL2 >= NBCOL1 ET NBLIG2 <= NBLIG1 40 : C 41 : C ********************************************************************** 42 : IMPLICIT INTEGER(I-N) 43 : INTEGER IGR1(*),NBLIG1,NBCOL1 44 : INTEGER IGR2(*),NBLIG2,NBCOL2 45 : REAL*8 COORD(*),RAPP 46 : INTEGER IDIMC,NBCOOR,ITVL(*),NITMAX 47 : INTEGER INDICE 48 : INTEGER IGRI(*),NBLIGI,NBCOLI,ITRACE,iarr 49 : C 50 : INTEGER NBCO11,NBLG11,IGR11 51 : INTEGER NBCOAJ(2),INCOAJ(2),NBLGAJ(2),INLGAJ(2),NBAJ(2) 52 : INTEGER INDXYZ,INCREM,ITRAV,I,J,K,NUM1,NUM2,IDECAL 53 : C REAL*8 COEF,CNBLG,CNBCO, 54 : REAL*8 XO,V12 55 : C 56 : C =============================================== 57 : C --- 0. VERIFICATIONS DES CONDITIONS D'APPLICATION --- 58 : C =============================================== 59 : IF(NBCOL1.GT.NBCOL2)THEN 60 : iarr = -1 60 : CALL DSERRE(1,iarr,'G2LLG2',' INVERSER LES 2 GRILLES ') 61 : GOTO 9999 62 : ENDIF 63 : C 64 : IF( ( MOD(NBCOL1+NBCOL2,2).NE.0 ).OR. 65 : > ( MOD(NBLIG1+NBLIG2,2).NE.0 ))THEN 66 : iarr = -1 66 : CALL DSERRE(1,iarr,'G2LLG2',' UNE COUCHE INSUFFISANTE ') 67 : GOTO 9999 68 : ENDIF 69 : C 70 : IF((NBCOL1.LE.NBCOL2).AND.(NBLIG1.GE.NBLIG2))THEN 71 : iarr = -1 71 : CALL DSERRE(1,iarr,'G2LLG2',' UNE COUCHE SUFFISANTE ') 72 : GOTO 9999 73 : ENDIF 74 : C 75 : IF(ITRACE.GT.0) 75 : > CALL ESECHA(1,'-> RACCORD EN 2 COUCHES',' ') 76 : C 77 : C =============================================== 78 : C --- 1. CALCUL DE LA SURFACE INTERMEDIAIRE : GRI --- 79 : C GRI -> GR2 : ON AUGMENTE SEULEMENT LES COLONNES 80 : C GR1 -> GRI : ON AUGMENTE SEULEMENT LES LIGNES 81 : C =============================================== 82 : NBLIGI = NBLIG2 83 : NBCOLI = NBCOL1 84 : C ------------------------------------ 85 : C ---- 1.1 ON COMPLETE LES LIGNES DE GR1 --- 86 : C ------------------------------------ 87 : NBAJ(1) = 0 88 : NBAJ(2) = 2 89 : INLGAJ(1) = 1 90 : NBLGAJ(1) = (NBLIG2-NBLIG1) / 2 91 : NBLGAJ(2) = (NBLIG2-NBLIG1) / 2 92 : INLGAJ(2) = -NBLIG1 93 : C 94 : IGR11 = 1 95 : ITRAV = 1 96 : IF( NITMAX.LT. (IGR11-1+ NBCOL1*NBLIG2))THEN 97 : iarr = -2 97 : CALL DSERRE(1,iarr,'G2LLG2',' POUR COMPLETER LA GRILLE ') 97 : CALL ESEINT(1,'PLACE NECESSAIRE ',NBCOL1*NBLIG2,1) 98 : GOTO 9999 99 : ENDIF 100 : C 101 : INDICE = NBCOOR+1 102 : INCREM = 1 103 : IF(ITRACE.GT.0)THEN 103 : CALL ESECHA(1,'-> NOUVEAUX NOEUDS',' ') 103 : CALL ESEINT(1,'A PARTIR DU NUMERO ',INDICE,1) 104 : ENDIF 105 : C 105 : CALL G2POLC(IGR1,NBLIG1,NBCOL1, 106 : > NBAJ,NBCOAJ,INCOAJ,NBLGAJ,INLGAJ, 107 : > INDICE,INCREM,COORD,NBCOOR,IDIMC, 108 : > ITVL(ITRAV),0, 109 : > ITVL(IGR11),NBLG11,NBCO11,iarr) 110 : C 111 : IF(iarr.NE.0)THEN 111 : CALL DSERRE(1,iarr,'G2LLG2',' APPEL G2POLC ') 112 : GOTO 9999 113 : ENDIF 114 : C 115 : IF(ITRACE.GT.0)THEN 115 : CALL ESECHA(1,'-> GRILLE 1 COMPLETEE',' ') 115 : CALL ESEINT(1,'COLONNES ',NBCO11,1) 115 : CALL ESEINT(1,'LIGNES ',NBLG11,1) 116 : ENDIF 117 : C 118 : C ----------------------------------------- 119 : C --- 1.2 CREATION D'UNE GRILLE 2D ET COLLAGE --- 120 : C ----------------------------------------- 121 : C 122 : IF(ITRACE.GT.0) 122 : > CALL ESECHA(1, 123 : > '2. CREATION DE LA GRILLES 3D ET COLLAGE : ',' ') 124 : C 124 : C CALL G2CRSP( NBLIGI,NBCOLI,INDICE,INCREM,IGRI ) 125 : DO 710 JG=1,(NBLIGI*NBCOLI) 126 : IGRI(JG)=INDICE 127 : INDICE = INDICE + INCREM 128 : 710 CONTINUE 129 : C ---------------------------- 130 : C --- 1.3 INTERPOLATION LINEAIRE 131 : C POUR LA GRILLE 2D --- 132 : C ---------------------------- 133 : C 134 : INDXYZ = NBCOOR + 1 135 : IF(ITRACE.GT.0) 135 : > CALL ESECHA(1,'-> COORDONNEES GRILLE 2D ',' ') 136 : C 137 : IDECAL = ( NBCOL2 - NBCOL1 ) / 2 138 : 139 : C 140 : C --- INTERPOLATION REMPLISSAGE PAR LIGNE --- 141 : C 142 : DO 110 I=1,NBLG11 143 : NUM1 = ITVL((I-1)*NBCO11+1+IGR11-1) 144 : NUM2 = IGR2((I-1)*NBCOL2+1) 145 : DO 70 K=1,IDIMC 146 : XO = COORD((NUM1-1)*IDIMC+K) 147 : V12 = COORD((NUM2-1)*IDIMC+K) - XO 148 : COORD((INDXYZ-1)*IDIMC+K) = V12*RAPP + XO 149 : 70 CONTINUE 150 : INDXYZ = INDXYZ + 1 151 : DO 90 J=2,NBCOL1-1 152 : C CORRECTION DU BUG : 1 => J 153 : NUM1 = ITVL((I-1)*NBCO11+J+IGR11-1) 154 : NUM2 = IGR2((I-1)*NBCOL2+J+IDECAL) 155 : DO 80 K=1,IDIMC 156 : XO = COORD((NUM1-1)*IDIMC+K) 157 : V12 = COORD((NUM2-1)*IDIMC+K) - XO 158 : COORD((INDXYZ-1)*IDIMC+K) = V12*RAPP + XO 159 : 80 CONTINUE 160 : INDXYZ = INDXYZ + 1 161 : 90 CONTINUE 162 : NUM1 = ITVL(I*NBCO11+IGR11-1) 163 : NUM2 = IGR2(I*NBCOL2) 164 : DO 100 K=1,IDIMC 165 : XO = COORD((NUM1-1)*IDIMC+K) 166 : V12 = COORD((NUM2-1)*IDIMC+K) - XO 167 : COORD((INDXYZ-1)*IDIMC+K) = V12*RAPP + XO 168 : 100 CONTINUE 169 : INDXYZ = INDXYZ + 1 170 : 110 CONTINUE 171 : C 172 : C 173 : 9999 END 174 : 175 : 176 :
© Cast3M 2003 - All rights reserved.
Disclaimer