1 : C GEOREG SOURCE CHAT 07/10/29 21:20:14 5940 2 : SUBROUTINE GEOREG(ITQUAF,MYFALS,MYFPGS, 3 : $ JMAREG, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : GEOREG 9 : C DESCRIPTION : 10 : * 11 : * Calcul du jacobien de la transformation : 12 : * élément volumique de référence -> élément réguliers 13 : * de côté 1 14 : * Cela sert pour l'adaptativité. 15 : C 16 : C LANGAGE : ESOPE 17 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 18 : C mél : gounand@semt2.smts.cea.fr 19 : C*********************************************************************** 20 : C APPELES : 21 : C APPELES (E/S) : 22 : C APPELES (BLAS) : 23 : C APPELES (CALCUL) : 24 : C APPELE PAR : 25 : C*********************************************************************** 26 : C SYNTAXE GIBIANE : 27 : C ENTREES : 28 : C ENTREES/SORTIES : 29 : C SORTIES : 30 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 31 : C*********************************************************************** 32 : C VERSION : v1, 04/10/2005, version initiale 33 : C HISTORIQUE : v1, 04/10/2005, création 34 : C HISTORIQUE : 35 : C HISTORIQUE : 36 : C*********************************************************************** 37 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 38 : C en cas de modification de ce sous-programme afin de faciliter 39 : C la maintenance ! 40 : C*********************************************************************** 41 : -INC CCOPTIO 42 : -INC CCGEOME 43 : CBEGININCLUDE SELREF 44 : SEGMENT ELREF 45 : CHARACTER*(LNNOM) NOMLRF 46 : CHARACTER*(LNFORM) FORME 47 : CHARACTER*(LNTYPL) TYPEL 48 : CHARACTER*(LNESP) ESPACE 49 : INTEGER DEGRE 50 : REAL*8 XCONOD(NDIMEL,NBNOD) 51 : INTEGER NPQUAF(NBDDL) 52 : INTEGER NUMCMP(NBDDL) 53 : INTEGER QUENOD(NBDDL) 54 : INTEGER ORDDER(NDIMEL,NBDDL) 55 : POINTEUR MBPOLY.POLYNS 56 : ENDSEGMENT 57 : SEGMENT ELREFS 58 : POINTEUR LISEL(0).ELREF 59 : ENDSEGMENT 60 : CENDINCLUDE SELREF 61 : POINTEUR ELCOUR.ELREF 62 : CBEGININCLUDE SFALRF 63 : SEGMENT FALRF 64 : CHARACTER*(LNNFA) NOMFA 65 : INTEGER NUQUAF(NBLRF) 66 : POINTEUR ELEMF(NBLRF).ELREF 67 : ENDSEGMENT 68 : SEGMENT FALRFS 69 : POINTEUR LISFA(0).FALRF 70 : ENDSEGMENT 71 : CENDINCLUDE SFALRF 72 : POINTEUR MYFALS.FALRFS 73 : CBEGININCLUDE SPOGAU 74 : SEGMENT POGAU 75 : CHARACTER*(LNNPG) NOMPG 76 : CHARACTER*(LNTPG) TYPMPG 77 : CHARACTER*(LNFPG) FORLPG 78 : INTEGER NORDPG 79 : REAL*8 XCOPG(NDLPG,NBPG) 80 : REAL*8 XPOPG(NBPG) 81 : ENDSEGMENT 82 : SEGMENT POGAUS 83 : POINTEUR LISPG(0).POGAU 84 : ENDSEGMENT 85 : CENDINCLUDE SPOGAU 86 : POINTEUR MYPGS.POGAUS 87 : POINTEUR PGCOUR.POGAU 88 : CBEGININCLUDE SFAPG 89 : SEGMENT FAPG 90 : CHARACTER*(LNNFAP) NOMFAP 91 : INTEGER NBQUAF(NBMPG) 92 : POINTEUR MPOGAU(NBMPG).POGAU 93 : ENDSEGMENT 94 : SEGMENT FAPGS 95 : POINTEUR LISFPG(0).FAPG 96 : ENDSEGMENT 97 : CENDINCLUDE SFAPG 98 : POINTEUR MYFPGS.FAPGS 99 : CBEGININCLUDE SMCHAEL 100 : SEGMENT MCHAEL 101 : POINTEUR IMACHE(N1).MELEME 102 : POINTEUR ICHEVA(N1).MCHEVA 103 : ENDSEGMENT 104 : SEGMENT MCHEVA 105 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 106 : ENDSEGMENT 107 : SEGMENT LCHEVA 108 : POINTEUR LISCHE(NBCHE).MCHEVA 109 : ENDSEGMENT 110 : CENDINCLUDE SMCHAEL 111 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM 112 : POINTEUR JCOOR.MCHEVA 113 : POINTEUR JMAREG.MCHEVA 114 : POINTEUR JMIREG.MCHEVA 115 : POINTEUR JDTREG.MCHEVA 116 : POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA 117 : * 118 : SEGMENT NOEREG 119 : REAL*8 XNOEUD(NDIM,NNLREG) 120 : ENDSEGMENT 121 : * 122 : CHARACTER*4 CQUAF,METGAU,MYDISC 123 : LOGICAL LBID 124 : INTEGER IMPR,IRET 125 : 126 : * 127 : * Executable statements 128 : * 129 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans georeg.eso' 130 : CQUAF=NOMS(ITQUAF) 131 : * 132 : * Here : SEGINI NOEREG 133 : * 134 : IF (CQUAF.EQ.'SEG3') THEN 135 : NNLREG=2 136 : NDIM =1 137 : SEGINI NOEREG 138 : XNOEUD(1,1)=0.D0 139 : XNOEUD(1,2)=1.D0 140 : * SEGDES NOEREG 141 : ELSEIF (CQUAF.EQ.'TRI7') THEN 142 : NNLREG=3 143 : NDIM =2 144 : SEGINI NOEREG 145 : XNOEUD(1,1)=0.D0 146 : XNOEUD(2,1)=0.D0 147 : XNOEUD(1,2)=1.D0 148 : XNOEUD(2,2)=0.D0 149 : XNOEUD(1,3)=0.5D0 150 : XNOEUD(2,3)=SQRT(3.D0)/2.D0 151 : * SEGDES NOEREG 152 : ELSEIF (CQUAF.EQ.'QUA9') THEN 153 : NNLREG=4 154 : NDIM =2 155 : SEGINI NOEREG 156 : XNOEUD(1,1)=0.D0 157 : XNOEUD(2,1)=0.D0 158 : XNOEUD(1,2)=1.D0 159 : XNOEUD(2,2)=0.D0 160 : XNOEUD(1,3)=1.D0 161 : XNOEUD(2,3)=1.D0 162 : XNOEUD(1,4)=0.D0 163 : XNOEUD(2,4)=1.D0 164 : * SEGDES NOEREG 165 : ELSEIF (CQUAF.EQ.'TE15') THEN 166 : NNLREG=4 167 : NDIM =3 168 : SEGINI NOEREG 169 : XNOEUD(1,1)=0.D0 170 : XNOEUD(2,1)=0.D0 171 : XNOEUD(3,1)=0.D0 172 : XNOEUD(1,2)=1.D0 173 : XNOEUD(2,2)=0.D0 174 : XNOEUD(3,2)=0.D0 175 : XNOEUD(1,3)=0.5D0 176 : XNOEUD(2,3)=SQRT(3.D0)/2.D0 177 : XNOEUD(3,3)=0.D0 178 : XNOEUD(1,4)=0.5D0 179 : XNOEUD(2,4)=SQRT(3.D0)/6.D0 180 : XNOEUD(3,4)=SQRT(6.D0)/3.D0 181 : * SEGDES NOEREG 182 : ELSEIF (CQUAF.EQ.'PY19') THEN 183 : NNLREG=5 184 : NDIM =3 185 : SEGINI NOEREG 186 : XNOEUD(1,1)=0.D0 187 : XNOEUD(2,1)=0.D0 188 : XNOEUD(3,1)=0.D0 189 : XNOEUD(1,2)=1.D0 190 : XNOEUD(2,2)=0.D0 191 : XNOEUD(3,2)=0.D0 192 : XNOEUD(1,3)=1.D0 193 : XNOEUD(2,3)=1.D0 194 : XNOEUD(3,3)=0.D0 195 : XNOEUD(1,4)=0.D0 196 : XNOEUD(2,4)=1.D0 197 : XNOEUD(3,4)=0.D0 198 : XNOEUD(1,5)=0.5D0 199 : XNOEUD(2,5)=0.5D0 200 : XNOEUD(3,5)=SQRT(2.D0)/2.D0 201 : * XNOEUD(3,5)=1.D0 202 : * SEGDES NOEREG 203 : ELSEIF (CQUAF.EQ.'PR21') THEN 204 : NNLREG=6 205 : NDIM =3 206 : SEGINI NOEREG 207 : XNOEUD(1,1)=0.D0 208 : XNOEUD(2,1)=0.D0 209 : XNOEUD(3,1)=0.D0 210 : XNOEUD(1,2)=1.D0 211 : XNOEUD(2,2)=0.D0 212 : XNOEUD(3,2)=0.D0 213 : XNOEUD(1,3)=0.5D0 214 : XNOEUD(2,3)=SQRT(3.D0)/2.D0 215 : XNOEUD(3,3)=0.D0 216 : * 217 : XNOEUD(1,4)=0.D0 218 : XNOEUD(2,4)=0.D0 219 : XNOEUD(3,4)=1.D0 220 : XNOEUD(1,5)=1.D0 221 : XNOEUD(2,5)=0.D0 222 : XNOEUD(3,5)=1.D0 223 : XNOEUD(1,6)=0.5D0 224 : XNOEUD(2,6)=SQRT(3.D0)/2.D0 225 : XNOEUD(3,6)=1.D0 226 : 227 : * SEGDES NOEREG 228 : ELSEIF (CQUAF.EQ.'CU27') THEN 229 : NNLREG=8 230 : NDIM =3 231 : SEGINI NOEREG 232 : XNOEUD(1,1)=0.D0 233 : XNOEUD(2,1)=0.D0 234 : XNOEUD(3,1)=0.D0 235 : XNOEUD(1,2)=1.D0 236 : XNOEUD(2,2)=0.D0 237 : XNOEUD(3,2)=0.D0 238 : XNOEUD(1,3)=1.D0 239 : XNOEUD(2,3)=1.D0 240 : XNOEUD(3,3)=0.D0 241 : XNOEUD(1,4)=0.D0 242 : XNOEUD(2,4)=1.D0 243 : XNOEUD(3,4)=0.D0 244 : * 245 : XNOEUD(1,5)=0.D0 246 : XNOEUD(2,5)=0.D0 247 : XNOEUD(3,5)=1.D0 248 : XNOEUD(1,6)=1.D0 249 : XNOEUD(2,6)=0.D0 250 : XNOEUD(3,6)=1.D0 251 : XNOEUD(1,7)=1.D0 252 : XNOEUD(2,7)=1.D0 253 : XNOEUD(3,7)=1.D0 254 : XNOEUD(1,8)=0.D0 255 : XNOEUD(2,8)=1.D0 256 : XNOEUD(3,8)=1.D0 257 : * SEGDES NOEREG 258 : ELSE 259 : WRITE(IOIMP,*) CQUAF,' regulier non implemente' 260 : GOTO 9999 261 : ENDIF 262 : * 263 : NBLIG=1 264 : NBCOL=XNOEUD(/2) 265 : N2LIG=1 266 : N2COL=XNOEUD(/1) 267 : NBPOI=1 268 : NBELM=1 269 : SEGINI JCOOR 270 : DO I=1,N2COL 271 : DO J=1,NBCOL 272 : JCOOR.VELCHE(1,J,1,I,1,1)=XNOEUD(I,J) 273 : ENDDO 274 : ENDDO 275 : * 276 : * On suppose la transformation linéaire entre élément de 277 : * référence et élément régulier => 1 point de Gauss 278 : * 279 : METGAU='GAU1' 279 : CALL KEPG(ITQUAF,METGAU, 280 : $ MYFPGS, 281 : $ PGCOUR, 282 : $ IMPR,IRET) 283 : IF (IRET.NE.0) GOTO 9999 284 : MYDISC='LINE' 284 : CALL KEEF(ITQUAF,MYDISC, 285 : $ MYFALS, 286 : $ ELCOUR, 287 : $ IMPR,IRET) 288 : IF (IRET.NE.0) GOTO 9999 289 : * In KFNREF : SEGINI FFPG 290 : * In KFNREF : SEGINI DFFPG 290 : CALL KFNREF(ELCOUR,PGCOUR, 291 : $ FFPG,DFFPG, 292 : $ IMPR,IRET) 293 : IF (IRET.NE.0) GOTO 9999 294 : * Création des matrices jacobiennes et déterminants 295 : * On ne garde que la matrice jacobienne. 296 : * In GEOLIN : SEGINI JMAREG 297 : * In GEOLIN : SEGINI JMIREG 298 : * In GEOLIN : SEGINI JDTREG 299 : NBELEM=1 300 : LBID=.FALSE. 301 : * 301 : CALL GEOLIN(DFFPG,JCOOR,NBELEM, 302 : $ JMAREG,JMIREG,JDTREG,LBID, 303 : $ IMPR,IRET) 304 : IF (IRET.NE.0) THEN 305 : IF (LBID) GOTO 9666 306 : GOTO 9999 307 : ENDIF 308 : SEGSUP JDTREG 309 : SEGSUP JMIREG 310 : SEGDES JMAREG 311 : SEGSUP DFFPG 312 : SEGSUP FFPG 313 : SEGSUP JCOOR 314 : SEGSUP NOEREG 315 : * SEGPRT,JMAREG 316 : * 317 : * Normal termination 318 : * 319 : IRET=0 320 : RETURN 321 : * 322 : * Format handling 323 : * 324 : * 325 : * Error handling 326 : * 327 : 9666 CONTINUE 328 : IRET=666 329 : RETURN 330 : 9999 CONTINUE 331 : IRET=1 332 : WRITE(IOIMP,*) 'An error was detected in subroutine georeg' 333 : RETURN 334 : * 335 : * End of subroutine GEOREG 336 : * 337 : END 338 : 339 : 340 :
© Cast3M 2003 - All rights reserved.
Disclaimer