1 : C H8RCGG SOURCE CHAT 06/03/29 21:23:05 5360 2 : C ********************************************************************** 3 : C FICHIER : GR3D_RACC.F 4 : C OBJET : RACCORD DE 2 MAILLAGES GRILLES. 5 : C FONCT. : 6 : C 7 : C OBJET H8RCGG : MAILLAGE H8 RACCORDANT 2 GRILLES COMPATIBLES 8 : C OBJET EN 2 COUCHES MINI.(NBCOL2 >= NBCOL1,NBLIG2 >= NBLIG1) 9 : C OBJET H8RCG2 : MAILLAGE H8 RACCORDANT 2 GRILLES COMPATIBLES 10 : C OBJET EN 1 COUCHE MINI.(NBCOL2 >= NBCOL1,NBLIG2 <= NBLIG1) 11 : C OBJET H8RCGI : MAILLAGE H8 S'APPUYANT 2 GRILLES IDENTIQUES 12 : C 13 : C AUTEUR : O. STAB 14 : C DATE : 06.96 15 : C MODIFICATIONS : 16 : C AUTEUR, DATE, OBJET : 17 : C 18 : C 19 : C ********************************************************************** 20 : C 21 : SUBROUTINE H8RCGG(IGR1,NBLIG1,NBCOL1, 22 : > IGR2,NBLIG2,NBCOL2,COORD,NBCOOR,IDIMC,NBCOUC,RAISON, 23 : > ITVL,NITMAX, 24 : > ITRNOE,NBNMAX,NBE,NBP, 25 : > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr) 26 : C ********************************************************************** 27 : C OBJET H8RCGG : MAILLAGE H8 RACCORDANT 2 GRILLES COMPATIBLES 28 : C OBJET EN 2 COUCHES MINI.(NBCOL2 >= NBCOL1,NBLIG2 >= NBLIG1) 29 : C 30 : C LES GRILLES IGR1 ET IGR2 SONT ORIENTEES DE LA MEME FACON 31 : C AVEC UNE ORIGINE COMPATIBLE IGR1(1) CORRESPOND A IGR2(1) 32 : C 33 : C APPELS : H8RCG2 34 : C 35 : C EN ENTREE : 36 : C 37 : C IGR1,NBLIG1,NBCOL1 : LA PREMIERE GRILLE 38 : C IGR CONTIENT LES NUMEROS DES NOEUDS 39 : C IGR2,NBLIG2,NBCOL2 : LA DEUXIEME GRILLE 40 : C NBCOUC : NOMBRE DE COUCHES SUPPLEMENTAIRES 41 : C (PAR DEFAUT 1 SEULE COUCHE) 42 : C 43 : C COORD,IDIMC : POSITION DES NOEUDS 44 : C 45 : C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS 46 : C NITMAX : TAILLE DE ITVL, LA PLACE NECESSAIRE EST DE 47 : C 2*NBCOL1*NBLIG2 POUR LA GRILLE INTERMEDIAIRE 48 : C + NBLIG1*NBCOL2*NBRAN 49 : C SI ICOMPR != 0 IL FAUT AJOUTER : 50 : C NBLIG3*NBCOL3*(NBRAN3-2) + NBCOOR 51 : C AVEC NBRAN = (3+NBCOUC+NBCOL2+NBLIG2-NBCOL1-NBLIG1) 52 : C 53 : C ITRNOE : TABLEAU DES ELEMENTS (A REMPLIR) 54 : C NBEMAX : NOMBRE MAXIMUM D'ELEMENTS 55 : C NBNMAX : NOMBRE MAXIMUM DE NOEUDS (LIE A LA TAILLE DE COORD) 56 : C 57 : C ICOMPR : FLAG DE COMPRESSION 58 : C ICOMPR = 0 LES NOEUDS ISOLES NE SONT PAS SUPPRIMES 59 : C LES ELEMENTS NULS " " " " 60 : C 61 : C EN SORTIE : 62 : C 63 : C ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,NBP : LE MAILLAGE RESULTANT 64 : C iarr : CODE D'ERREUR -1 SI DONNEES INCORRECTES 65 : C -2 SI TABLEAUX INSUFFISANTS 66 : C 67 : C REMARQUE : L'ALGORITHME GENERE LES NOEUDS D'UNE GRILLE COMPLETE 68 : C APRES LE COUPER-COLLER CERTAIN NOEUDS DEVIENDRONT ISOLES 69 : C ET CERTAIN ELEMENTS SERONT NON VALIDES (NULS). 70 : C LE FLAG "ICOMPR" PERMET DE LES SUPPRIMER 71 : C ********************************************************************** 72 : IMPLICIT INTEGER(I-N) 73 : INTEGER IGR1(*),NBLIG1,NBCOL1 74 : INTEGER IGR2(*),NBLIG2,NBCOL2 75 : REAL*8 COORD(*),RAISON,XYZEPS 76 : INTEGER IDIMC,NBCOOR,NBCOUC,ITVL(*),NITMAX 77 : INTEGER ITRNOE(*),NBNMAX,NBE,NBP 78 : INTEGER NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr 79 : C 80 : C COMMON /CGEPSI/ XYZHUG,XYZMIN,XYZEPS 81 : CS REAL*8 XYZHUG,XYZMIN,XYZEPS 82 : C 83 : INTEGER NBLIG3,NBCOL3,NBRAN3,NBEGEN,NBPGEN 84 : INTEGER IGR3,ITRAV,ITRVMX,INDICE,ITRNO3,NBE3 85 : INTEGER NBCOU1,NBCOU2 86 : REAL*8 RAPP,CNDELG,CNDECO,RAISO3,RBCOU1,RBCOU2,UNR 87 : C 88 : C ----------------------------------- 89 : C --- EVALUATION DE LA PLACE NECESSAIRE --- 90 : C ----------------------------------- 91 : XYZEPS=1.d-10 92 : NBLIG3 = NBCOL1 93 : NBCOL3 = (NBLIG2-NBLIG1)/2 +2+NBCOUC-1 94 : NBRAN3 = NBLIG2 95 : C 96 : NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1) 97 : NBPGEN = NBLIG3*NBCOL3*NBRAN3 98 : C 99 : NBLIG3 = NBCOL2 100 : NBCOL3 = (NBCOL2-NBCOL1)/2 +2+NBCOUC-1 101 : NBRAN3 = NBLIG2 102 : C 103 : NBEGEN = (NBLIG3-1)*(NBCOL3-1)*(NBRAN3-1) + NBEGEN 104 : NBPGEN = NBLIG3*NBCOL3*NBRAN3 + NBPGEN 105 : C 106 : C --- MAILLAGE EN H8 --- 107 : C 108 : IF((NBEMAX.LT.NBEGEN).OR.(NBPMAX.LT.NBPGEN))THEN 109 : iarr = -2 110 : GOTO 9999 111 : ENDIF 112 : C 113 : IGR3 = 1 114 : C ITRAV = NBCOL2*NBLIG1 + IGR3 115 : C 116 : C BUG18 : PLACE INSUFISANTE - CORRECT 17.03.97 O.STAB 117 : C 118 : ITRAV = MAX(NBCOL2*NBLIG1,NBCOL1*NBLIG2) + IGR3 119 : ITRVMX = NITMAX - ITRAV 120 : INDICE = NBCOOR + 1 121 : C --- IGR1 -> IGR3 AUGMENTANT LES LIGNES --- 122 : C 123 : C =============================== 124 : C ---- REPARTITION SUR LES 2 COUCHES ---- 125 : C =============================== 126 : C 127 : C CNBCO = (NBCOL2 - NBCOL1 )/2 + 1 128 : C CNBLG = (NBLIG2 - NBLIG1 )/2 + 1 129 : C RAPP = CNBLG / (CNBLG+CNBCO) 130 : C 131 : CNDELG = (NBLIG2 - NBLIG1)/2.0 + 1.0 132 : CNDECO = (NBCOL2 - NBCOL1)/2.0 + 1.0 133 : UNR = 1.0 134 : RBCOU1 = MAX((NBCOUC*CNDELG)/(CNDELG+CNDECO), UNR) 135 : RBCOU2 = MAX((NBCOUC*CNDECO)/(CNDELG+CNDECO), UNR) 136 : NBCOU1 = NINT(RBCOU1) 137 : NBCOU2 = NINT(RBCOU2) 138 : C 139 : RAPP = 1. - RAISON**(NBCOU1+NBCOU2) 140 : IF((RAPP.LE.XYZEPS).AND.(RAPP.GE.-XYZEPS))THEN 141 : C RAPP = N1 / (N1 + N2) 142 : RAPP = CNDELG / (CNDELG+CNDECO) 143 : C RAISO3 = RAISON 144 : ELSE 145 : RAPP =(1.-RAISON**NBCOU1)/(1.-RAISON**(NBCOU1+NBCOU2)) 146 : C RAISO3 = RAISON**NBCOU1 147 : ENDIF 148 : RAISO3 = RAISON 149 : C 149 : CALL G2LLG2(IGR1,NBLIG1,NBCOL1, 150 : > IGR2,NBLIG2,NBCOL2, 151 : > COORD,NBCOOR,IDIMC,INDICE,RAPP, 152 : > ITVL(ITRAV),ITRVMX, 153 : > ITVL(IGR3),NBLIG3,NBCOL3,ITRACE,iarr) 154 : C 155 : IF(iarr.NE.0)THEN 155 : CALL DSERRE(1,iarr,'ESG3CR',' APPEL G2LLG2') 156 : GOTO 9999 157 : ENDIF 158 : C 159 : IF(ITRACE.GT.0)THEN 159 : CALL ESECHA(1,'-> GRILLE INTERMEDIAIRE ',' ') 159 : CALL ESEINT(1,'COLONNES : ',NBCOL3,1) 159 : CALL ESEINT(1,'LIGNES : ',NBLIG3,1) 159 : CALL ESEINT(1,'NOEUDS GENERES : ',INDICE - 1 - NBCOOR,1) 160 : ENDIF 161 : NBCOOR = INDICE - 1 162 : C 162 : IF(ITRACE.GT.0)CALL ESECHA(1,' PREMIERE COUCHE : ',' ') 163 : ITRVMX = NITMAX - ITRAV 164 : RAISO3 = 1.0 / RAISON 164 : CALL H8RCG2(ITVL(IGR3),NBLIG3,NBCOL3, 165 : > IGR1,NBLIG1,NBCOL1, 166 : > COORD,NBCOOR,IDIMC,NBCOU1,RAISO3, 167 : > ITVL(ITRAV),ITRVMX, 168 : > ITRNOE,NBNMAX,NBE,NBP, 169 : > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr) 170 : C 170 : IF(ITRACE.GT.0)CALL ESECHA(1,' DEUXIEME COUCHE : ',' ') 171 : ITRNO3 = NBNMAX*NBE + 1 172 : RAISO3 = RAISON 172 : CALL H8RCG2(ITVL(IGR3),NBLIG3,NBCOL3, 173 : > IGR2,NBLIG2,NBCOL2, 174 : > COORD,NBCOOR,IDIMC,NBCOU2,RAISO3, 175 : > ITVL(ITRAV),ITRVMX, 176 : > ITRNOE(ITRNO3),NBNMAX,NBE3,NBP, 177 : > NBEMAX,NBPMAX,ICOMPR,ITRACE,iarr) 178 : NBE = NBE + NBE3 179 : C 180 : 9999 END 181 : 182 : 183 :
© Cast3M 2003 - All rights reserved.
Disclaimer