1 : C H8RCGI SOURCE CHAT 06/03/29 21:23:09 5360 2 : SUBROUTINE H8RCGI(IGR11,NBLG11,NBCO11, 3 : > IGR22,NBLG22,NBCO22,COORD,NBCOOR,IDIMC,NBCOUC,RAISON, 4 : > NBLIG3,NBCOL3,NBRAN3,IARETE,NARETE, 5 : > ITVL,NITMAX, 6 : > ITRNOE,NBNMAX,NBE,NBP, 7 : > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr) 8 : C ********************************************************************** 9 : C OBJET H8RCGI : MAILLAGE H8 S'APPUYANT 2 GRILLES IDENTIQUES 10 : C 11 : C ON GENERE UNE GRILLE 3D QUI S'APPUIT INITIALEMENT SUR LES GRILLES 12 : C IGR11 ET IGR22 PUIS ON APPLIQUE DES "COUPER-COLLER" DONNES (NARETE) 13 : C 14 : C EN ENTREE : 15 : C 16 : C IGR11,NBLIG11,NBCOL11 : LA PREMIERE GRILLE 17 : C IGR22,NBLIG22,NBCOL22 : LA DEUXIEME GRILLE 18 : C COORD,NBCOOR,IDIMC : POSITION DES NOEUDS 19 : C 20 : C NBCOUC : NOMBRE DE COUCHES SUPPLEMENTAIRES 21 : C (PAR DEFAUT 1 SEULE COUCHE) 22 : C NBLIG3,NBCOL3,NBRAN3 : GRILLE 3D DE RACCORD 23 : C IARETE,NARETE : INDICE ET CARDINAUX DES RANGEES A COUPER 24 : C A ET RECOLLER 25 : C 26 : C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS 27 : C NITMAX : TAILLE DE ITVL, LA PLACE NECESSAIRE EST DE 28 : C NBLIG3*NBCOL3*NBRAN3 AU MINIMUM, SI ICOMPR= 0 29 : C SINON IL FAUT AJOUTER : NBLIG3*NBCOL3*(NBRAN3-2) + NBCOOR 30 : C 31 : C ITRNOE : TABLEAU DES ELEMENTS (A REMPLIR) 32 : C NBEMAX : NOMBRE MAXIMUM D'ELEMENTS 33 : C NBPMAX : NOMBRE MAXIMUM DE NOEUDS (LIE A LA TAILLE DE COORD) 34 : C 35 : C ICOMPR : FLAG DE COMPRESSION 36 : C ICOMPR = 0 LES NOEUDS ISOLES NE SONT PAS SUPPRIMES 37 : C LES ELEMENTS NULS " " " " 38 : C 39 : C EN SORTIE : 40 : C 41 : C ITRNOE,NBNMAX,ITRTRI,NBE,NBP : LE MAILLAGE RESULTANT 42 : C iarr : CODE D'ERREUR -1 SI DONNEES INCORRECTES 43 : C -2 SI TABLEAUX INSUFFISANTS 44 : C 45 : C REMARQUE : L'ALGORITHME GENERE LES NOEUDS D'UNE GRILLE COMPLETE 46 : C APRES LE COUPER-COLLER CERTAIN NOEUDS DEVIENDRONT ISOLES 47 : C ET CERTAIN ELEMENTS SERONT NON VALIDES (NULS). 48 : C LE FLAG "ICOMPR" PERMET DE LES SUPPRIMER 49 : C ********************************************************************** 50 : IMPLICIT INTEGER(I-N) 51 : INTEGER IGR11(*),NBLG11,NBCO11 52 : INTEGER IGR22(*),NBLG22,NBCO22 53 : REAL*8 COORD(*),RAISON 54 : INTEGER IDIMC,NBCOOR,NBCOUC 55 : INTEGER NBLIG3,NBCOL3,NBRAN3,IARETE(*),NARETE(*) 56 : INTEGER ITVL(*),NITMAX 57 : INTEGER ITRNOE(*),NBNMAX,NBE,NBP 58 : INTEGER NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr 59 : C 60 : C COMMON /CGEPSI/ XYZHUG,XYZMIN,XYZEPS 61 : C REAL*8 XYZHUG,XYZMIN,XYZEPS 62 : C 63 : INTEGER IGR3 64 : INTEGER INDICE,I,J,K 65 : REAL*8 XO,V12,XN,COEF,XYZEPS 66 : INTEGER NRANAJ,INDXYZ,NUM1,NUM2,KK 67 : INTEGER NOETRI,NBISOL,NOEMAX,NBENUL 68 : INTEGER IDE,NBCMAX,ITRTRI,INUL 69 : XYZEPS=1.D-10 70 : C 71 : C ======================================= 72 : C --- 2.CREATION D'UNE GRILLE 3D ET COLLAGE --- 73 : C ======================================= 74 : C 75 : IF(ITRACE.GT.0) 75 : > CALL ESECHA(1, 76 : > '2. CREATION DE LA GRILLES 3D ET COLLAGE : ',' ') 77 : C 78 : IGR3 = 1 79 : C INUL = 0 79 : C CALL G3CRSP( NBLIG3,NBCOL3,NBRAN3,INUL,INUL,ITVL(IGR3) ) 80 : DO 141 I=1,NBLIG3*NBCOL3*NBRAN3 81 : 141 ITVL(I) = 0 82 : C 83 : C --------------------------------------------- 84 : C --- 2.1 TRANSFERT DES 2 FACES DANS LA GRILLE 3D --- 85 : C --------------------------------------------- 86 : C --- ON TRANSFERT --- 87 : C IGR1 = (I,J) -> (1,I,J) 88 : C 89 : C 90 : DO 150 I=1,NBCO11 91 : DO 140 J=1,NBLG11 92 : ITVL((J-1)*NBLIG3*NBCOL3 + (I-1)*NBCOL3+IGR3) = 93 : > IGR11((J-1)*NBCO11+I) 94 : 140 CONTINUE 95 : 150 CONTINUE 96 : C 97 : C IGR2 = (I,J) -> (NBCOL,I,J) 98 : C 99 : DO 170 I=1,NBCO22 100 : DO 160 J=1,NBLG22 101 : ITVL((J-1)*NBLIG3*NBCOL3 + (I-1)*NBCOL3+NBCOL3+IGR3-1) = 102 : > IGR22((J-1)*NBCO22+I) 103 : 160 CONTINUE 104 : 170 CONTINUE 105 : C 106 : INDICE = NBCOOR + 1 107 : DO 190 I=1,(NBRAN3*NBCOL3*NBLIG3) 108 : IF( ITVL(IGR3+I-1).EQ.0 )THEN 109 : ITVL(IGR3+I-1) = INDICE 110 : INDICE = INDICE + 1 111 : ENDIF 112 : 190 CONTINUE 113 : C 114 : C ------------------------------------ 115 : C --- 2.2 COLLAGE DES ARETES DU MAILLAGE --- 116 : C ------------------------------------ 117 : C 118 : C --- ON PASSE SUR LA STRUCTURE MAILLAGE --- 119 : C 120 : IF(ITRACE.GT.0)THEN 120 : CALL ESECHA(1,'-> CONNECTIQUE GRILLE 3D ET COLLAGE',' ') 120 : CALL ESEINT(1,'COLONNES ',NBCOL3,1) 120 : CALL ESEINT(1,'LIGNES ',NBLIG3,1) 120 : CALL ESEINT(1,'RANGEES ',NBRAN3,1) 120 : CALL ESEINT(1,'A COLLER SUR LES ARETES 7,8,10 ET 2 ', 121 : > NARETE(1),4) 122 : ENDIF 123 : C 123 : CALL H8CRSP(NBCOL3-1,NBLIG3-1,NBRAN3-1, 124 : > ITRNOE,NBNMAX,NBE,NBP,iarr) 125 : C 126 : C --- 1.2 COLLAGE DES ARETES (SUR LE MAILLAGE !) --- 127 : C 128 : DO 10 I=1,4 128 : CALL G3GLKK(IARETE(I),NARETE(I), 129 : > (NBLIG3-1),(NBCOL3-1),(NBRAN3-1), 130 : > ITRNOE,NBNMAX,iarr) 131 : 10 CONTINUE 132 : IF( iarr.NE.0)THEN 132 : CALL DSERRE(1,iarr,'H8RCG2','APPEL G3GLKK') 133 : GOTO 9999 134 : ENDIF 135 : C 136 : C --- RENUMEROTATION DES NOEUDS DU MAILLAGE --- 137 : C PAR LES NOEUDS DE LA GRILLE 138 : C 139 : DO 5 I=1,NBE*NBNMAX 140 : IF(ITRNOE(I).GT.0)ITRNOE(I) = ITVL(IGR3+ITRNOE(I)-1) 141 : 5 CONTINUE 142 : C 143 : C ---------------------------- 144 : C --- INTERPOLATION LINEAIRE POUR 145 : C COMPLETER LA GRILLE 3D --- 146 : C ---------------------------- 147 : C 148 : INDXYZ = NBCOOR + 1 149 : IF(ITRACE.GT.0) 149 : > CALL ESECHA(1,'-> COORDONNEES GRILLE 3D ',' ') 150 : C 151 : C NRANAJ = NARETE(1)+NARETE(3) 152 : NRANAJ = NBCOL3 - 2 153 : XN = 1 - RAISON**(NRANAJ+1) 154 : IF((XN.LE.XYZEPS).AND.(XN.GE.-XYZEPS))THEN 155 : RAISON = 1.0 156 : XN = 1.0 / (NRANAJ + 1.0) 157 : ELSE 158 : XN = 1.0 / XN 159 : ENDIF 160 : C 161 : DO 100 I=1,NBLG11 162 : DO 90 J=1,NBCO11 163 : DO 80 K=1,NRANAJ 164 : C --- INTERPOLATION ENTRE LE PLAN IGR11 ET IGR22 --- 165 : NUM1 = IGR11((I-1)*NBCO11+J) 166 : NUM2 = IGR22((I-1)*NBCO11+J) 167 : IF( RAISON.EQ.1 )THEN 168 : COEF = K 169 : ELSE 170 : COEF = 1 - RAISON**K 171 : ENDIF 172 : DO 70 KK=1,IDIMC 173 : XO = COORD((NUM1-1)*IDIMC+KK) 174 : V12 = COORD((NUM2-1)*IDIMC+KK) - XO 175 : COORD((INDXYZ-1)*IDIMC+KK) = V12*XN*COEF + XO 176 : 70 CONTINUE 177 : INDXYZ = INDXYZ + 1 178 : 80 CONTINUE 179 : 90 CONTINUE 180 : 100 CONTINUE 181 : NBCOOR = INDXYZ - 1 182 : C 183 : C ============================ 184 : C --- 3. COMPRESSION DES NOEUDS --- 185 : C ============================ 186 : C 187 : IF( ICOMPR.EQ. 0 )GO TO 9999 188 : IF(ITRACE.GT.0) 188 : > CALL ESECHA(1,'* POST TRAITEMENT : ',' COMPRESSION ') 189 : C 190 : IDE = 3 191 : NBCMAX = 0 192 : ITRTRI = 0 193 : NOEMAX = 0 194 : NOETRI = 0 195 : NBENUL = NBE 196 : NBISOL = NBP 196 : CALL NUGCNU(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX, 197 : > NOETRI,NOEMAX,NBE,COORD,IDIMC,NBP, 198 : > ITVL,NITMAX,iarr) 199 : C 200 : IF(ITRACE.GT.0)THEN 200 : CALL ESECHA(1,'* MAILLAGE -> COMPRESSION ',' ') 200 : CALL ESEINT(1,'NOMBRE D ELEMENTS SUPPRIMES : ',NBENUL-NBE,1) 200 : CALL ESEINT(1,'NOMBRE DE POINTS SUPPRIMES : ',NBISOL-NBP,1) 201 : ENDIF 202 : C 203 : 9999 END 204 : 205 : 206 :
© Cast3M 2003 - All rights reserved.
Disclaimer