1 : C INELTE SOURCE GOUNAND 06/12/19 21:15:24 5612 2 : SUBROUTINE INELTE(MYLRFS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INELTE 7 : C PROJET : Noyau linéaire NLIN 8 : C DESCRIPTION : Remplit le segment des éléments de référence 9 : C avec les éléments de référence de dimension 3, 10 : C de forme tétraèdrique. 11 : C REFERENCES : 12 : C LANGAGE : ESOPE 13 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 14 : C mél : gounand@semt2.smts.cea.fr 15 : C*********************************************************************** 16 : C APPELES : INILRF, INILAG, GBAPCO, GPOBUL, GPOFBU 17 : C APPELE PAR : INLRFS 18 : C*********************************************************************** 19 : C ENTREES : - 20 : C ENTREES/SORTIES : MYLRFS 21 : C SORTIES : - 22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 23 : C*********************************************************************** 24 : C VERSION : v1, 23/03/00, version initiale 25 : C HISTORIQUE : v1, 23/03/00, création 26 : C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF 27 : C HISTORIQUE : 28 : C HISTORIQUE : 29 : C*********************************************************************** 30 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 31 : C en cas de modification de ce sous-programme afin de faciliter 32 : C la maintenance ! 33 : C*********************************************************************** 34 : -INC CCOPTIO 35 : CBEGININCLUDE SELREF 36 : SEGMENT ELREF 37 : CHARACTER*(LNNOM) NOMLRF 38 : CHARACTER*(LNFORM) FORME 39 : CHARACTER*(LNTYPL) TYPEL 40 : CHARACTER*(LNESP) ESPACE 41 : INTEGER DEGRE 42 : REAL*8 XCONOD(NDIMEL,NBNOD) 43 : INTEGER NPQUAF(NBDDL) 44 : INTEGER NUMCMP(NBDDL) 45 : INTEGER QUENOD(NBDDL) 46 : INTEGER ORDDER(NDIMEL,NBDDL) 47 : POINTEUR MBPOLY.POLYNS 48 : ENDSEGMENT 49 : SEGMENT ELREFS 50 : POINTEUR LISEL(0).ELREF 51 : ENDSEGMENT 52 : CENDINCLUDE SELREF 53 : POINTEUR MYLRFS.ELREFS 54 : POINTEUR ELCOUR.ELREF 55 : CBEGININCLUDE SPOLYNO 56 : SEGMENT POLYNO 57 : REAL*8 COEMON(NBMON) 58 : INTEGER EXPMON(NDIML,NBMON) 59 : ENDSEGMENT 60 : SEGMENT POLYNS 61 : POINTEUR LIPOLY(NBPOLY).POLYNO 62 : ENDSEGMENT 63 : CENDINCLUDE SPOLYNO 64 : POINTEUR MYBPOL.POLYNS 65 : * 66 : INTEGER IMPR,IRET 67 : * Elément de nom : L2D0TE1 68 : REAL*8 UNS4 69 : PARAMETER (UNS4=0.25D0) 70 : * Elément de nom : L2D1TE4 71 : REAL*8 RAC3,TROS4 72 : PARAMETER (RAC3=1.7320508075688772935274463415059D0) 73 : PARAMETER (TROS4=0.75D0) 74 : * Elément de nom : H1D1TE4 75 : REAL*8 ZERO,UN 76 : PARAMETER (ZERO=0.D0,UN=1.D0) 77 : * Elément de nom : H1D2TE15 78 : REAL*8 UNS2,UNS3 79 : PARAMETER (UNS2=1.D0/2.D0,UNS3=1.D0/3.D0) 80 : * 81 : INTEGER INDDL 82 : * 83 : * Executable statements 84 : * 85 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelte' 86 : * 87 : * Elément de nom : L2D0TE1 88 : * Sur un triangle : élément de Lagrange, fonction L2, approximation 89 : * nodale, espace de référence de dimension 3, 1 noeud, 1 degré de 90 : * liberté, degré de l'approximation : 0 91 : * 92 : * In INILRF : SEGINI ELCOUR 92 : CALL INILRF('L2D0TE1','TETRAEDRE','LAGRANGE','L2', 93 : $ 3,1,1,0, 94 : $ ELCOUR, 95 : $ IMPR,IRET) 96 : IF (IRET.NE.0) GOTO 9999 97 : ELCOUR.XCONOD(1,1)=UNS4 98 : ELCOUR.XCONOD(2,1)=UNS4 99 : ELCOUR.XCONOD(3,1)=UNS4 100 : ELCOUR.NPQUAF(1)=15 101 : ELCOUR.NUMCMP(1)=1 102 : * Initialise la correspondance ddl-noeud+ord.der 102 : CALL INILAG(ELCOUR,IMPR,IRET) 103 : IF (IRET.NE.0) GOTO 9999 104 : * Génère une base polynômiale complète (dimension 3, degré 0) 104 : CALL GBAPCO(3,0,MYBPOL,IMPR,IRET) 105 : IF (IRET.NE.0) GOTO 9999 106 : ELCOUR.MBPOLY=MYBPOL 107 : SEGDES ELCOUR 108 : MYLRFS.LISEL(**)=ELCOUR 109 : * 110 : * Elément de nom : L2D1TE4 111 : * Sur un tétraèdre : élément de Lagrange, fonction L2, approximation 112 : * nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de 113 : * liberté, degré de l'approximation : 1 114 : * 115 : * In INILRF : SEGINI ELCOUR 115 : CALL INILRF('L2D1TE4','TETRAEDRE','LAGRANGE','L2', 116 : $ 3,4,4,1, 117 : $ ELCOUR, 118 : $ IMPR,IRET) 119 : IF (IRET.NE.0) GOTO 9999 120 : ELCOUR.XCONOD(1,1)=RAC3*UNS4 121 : ELCOUR.XCONOD(2,1)=RAC3*UNS4 122 : ELCOUR.XCONOD(3,1)=UNS4 123 : ELCOUR.XCONOD(1,2)=RAC3*TROS4 124 : ELCOUR.XCONOD(2,2)=RAC3*UNS4 125 : ELCOUR.XCONOD(3,2)=UNS4 126 : ELCOUR.XCONOD(1,3)=RAC3*TROS4 127 : ELCOUR.XCONOD(2,3)=RAC3*TROS4 128 : ELCOUR.XCONOD(3,3)=UNS4 129 : ELCOUR.XCONOD(1,4)=RAC3*UNS4 130 : ELCOUR.XCONOD(2,4)=RAC3*UNS4 131 : ELCOUR.XCONOD(3,4)=TROS4 132 : ELCOUR.NPQUAF(1)=15 133 : ELCOUR.NUMCMP(1)=1 134 : ELCOUR.NPQUAF(2)=15 135 : ELCOUR.NUMCMP(2)=2 136 : ELCOUR.NPQUAF(3)=15 137 : ELCOUR.NUMCMP(3)=3 138 : ELCOUR.NPQUAF(4)=15 139 : ELCOUR.NUMCMP(4)=4 140 : * Initialise la correspondance ddl-noeud+ord.der 140 : CALL INILAG(ELCOUR,IMPR,IRET) 141 : IF (IRET.NE.0) GOTO 9999 142 : * Génère une base polynômiale complète (dimension 3, degré 1) 142 : CALL GBAPCO(3,1,MYBPOL,IMPR,IRET) 143 : IF (IRET.NE.0) GOTO 9999 144 : ELCOUR.MBPOLY=MYBPOL 145 : SEGDES ELCOUR 146 : MYLRFS.LISEL(**)=ELCOUR 147 : * 148 : * Elément de nom : H1D1TE4 149 : * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation 150 : * nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de 151 : * liberté, degré de l'approximation : 1, degré du polynôme 152 : * d'interpolation 1 153 : * 154 : * In INILRF : SEGINI ELCOUR 154 : CALL INILRF('H1D1TE4','TETRAEDRE','LAGRANGE','H1', 155 : $ 3,4,4,1, 156 : $ ELCOUR, 157 : $ IMPR,IRET) 158 : IF (IRET.NE.0) GOTO 9999 159 : ELCOUR.XCONOD(1,1)=ZERO 160 : ELCOUR.XCONOD(2,1)=ZERO 161 : ELCOUR.XCONOD(3,1)=ZERO 162 : ELCOUR.XCONOD(1,2)=UN 163 : ELCOUR.XCONOD(2,2)=ZERO 164 : ELCOUR.XCONOD(3,2)=ZERO 165 : ELCOUR.XCONOD(1,3)=ZERO 166 : ELCOUR.XCONOD(2,3)=UN 167 : ELCOUR.XCONOD(3,3)=ZERO 168 : ELCOUR.XCONOD(1,4)=ZERO 169 : ELCOUR.XCONOD(2,4)=ZERO 170 : ELCOUR.XCONOD(3,4)=UN 171 : * Les d.d.l. sont aux noeuds 1,3,5,10 172 : ELCOUR.NPQUAF(1)=1 173 : ELCOUR.NPQUAF(2)=3 174 : ELCOUR.NPQUAF(3)=5 175 : ELCOUR.NPQUAF(4)=10 176 : DO 213 INDDL=1,4 177 : ELCOUR.NUMCMP(INDDL)=1 178 : 213 CONTINUE 179 : * Initialise la correspondance ddl-noeud+ord.der 179 : CALL INILAG(ELCOUR,IMPR,IRET) 180 : IF (IRET.NE.0) GOTO 9999 181 : * Génère une base polynômiale complète (dimension 3, degré 1) 181 : CALL GBAPCO(3,1,MYBPOL,IMPR,IRET) 182 : IF (IRET.NE.0) GOTO 9999 183 : ELCOUR.MBPOLY=MYBPOL 184 : SEGDES ELCOUR 185 : MYLRFS.LISEL(**)=ELCOUR 186 : * 187 : * Elément de nom : CRD1TE4 188 : * Sur un tétraèdre : élément de Lagrange, fonction continue au centre 189 : * des faces, approximation 190 : * nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de 191 : * liberté, degré de l'approximation : 1, degré du polynôme 192 : * d'interpolation 1 193 : * 194 : * In INILRF : SEGINI ELCOUR 194 : CALL INILRF('CRD1TE4','TETRAEDRE','LAGRANGE','H1', 195 : $ 3,4,4,1, 196 : $ ELCOUR, 197 : $ IMPR,IRET) 198 : IF (IRET.NE.0) GOTO 9999 199 : ELCOUR.XCONOD(1,1)=UNS3 200 : ELCOUR.XCONOD(2,1)=UNS3 201 : ELCOUR.XCONOD(3,1)=ZERO 202 : ELCOUR.XCONOD(1,2)=UNS3 203 : ELCOUR.XCONOD(2,2)=ZERO 204 : ELCOUR.XCONOD(3,2)=UNS3 205 : ELCOUR.XCONOD(1,3)=UNS3 206 : ELCOUR.XCONOD(2,3)=UNS3 207 : ELCOUR.XCONOD(3,3)=UNS3 208 : ELCOUR.XCONOD(1,4)=ZERO 209 : ELCOUR.XCONOD(2,4)=UNS3 210 : ELCOUR.XCONOD(3,4)=UNS3 211 : * Les d.d.l. sont aux noeuds 11,12,13,14 212 : DO INDDL=1,4 213 : ELCOUR.NPQUAF(INDDL)=INDDL+10 214 : ELCOUR.NUMCMP(INDDL)=1 215 : ENDDO 216 : * Initialise la correspondance ddl-noeud+ord.der 216 : CALL INILAG(ELCOUR,IMPR,IRET) 217 : IF (IRET.NE.0) GOTO 9999 218 : * Génère une base polynômiale complète (dimension 3, degré 1) 218 : CALL GBAPCO(3,1,MYBPOL,IMPR,IRET) 219 : IF (IRET.NE.0) GOTO 9999 220 : ELCOUR.MBPOLY=MYBPOL 221 : SEGDES ELCOUR 222 : MYLRFS.LISEL(**)=ELCOUR 223 : * 224 : * Elément de nom : H1D1TE5 225 : * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation 226 : * nodale, espace de référence de dimension 3, 5 noeuds, 5 degrés de 227 : * liberté, degré de l'approximation : 1, degré du polynôme 228 : * d'interpolation 3 229 : * 230 : * In INILRF : SEGINI ELCOUR 230 : CALL INILRF('H1D1TE5','TETRAEDRE','LAGRANGE','H1', 231 : $ 3,5,5,1, 232 : $ ELCOUR, 233 : $ IMPR,IRET) 234 : IF (IRET.NE.0) GOTO 9999 235 : ELCOUR.XCONOD(1,1)=ZERO 236 : ELCOUR.XCONOD(2,1)=ZERO 237 : ELCOUR.XCONOD(3,1)=ZERO 238 : ELCOUR.XCONOD(1,2)=UN 239 : ELCOUR.XCONOD(2,2)=ZERO 240 : ELCOUR.XCONOD(3,2)=ZERO 241 : ELCOUR.XCONOD(1,3)=ZERO 242 : ELCOUR.XCONOD(2,3)=UN 243 : ELCOUR.XCONOD(3,3)=ZERO 244 : ELCOUR.XCONOD(1,4)=ZERO 245 : ELCOUR.XCONOD(2,4)=ZERO 246 : ELCOUR.XCONOD(3,4)=UN 247 : ELCOUR.XCONOD(1,5)=UNS4 248 : ELCOUR.XCONOD(2,5)=UNS4 249 : ELCOUR.XCONOD(3,5)=UNS4 250 : * Les d.d.l. sont aux noeuds 1,3,5,10,15 251 : ELCOUR.NPQUAF(1)=1 252 : ELCOUR.NPQUAF(2)=3 253 : ELCOUR.NPQUAF(3)=5 254 : ELCOUR.NPQUAF(4)=10 255 : ELCOUR.NPQUAF(5)=15 256 : DO 215 INDDL=1,5 257 : ELCOUR.NUMCMP(INDDL)=1 258 : 215 CONTINUE 259 : * Initialise la correspondance ddl-noeud+ord.der 259 : CALL INILAG(ELCOUR,IMPR,IRET) 260 : IF (IRET.NE.0) GOTO 9999 261 : * Génère une base polynômiale complète (dimension 3, degré 1) 261 : CALL GBAPCO(3,1,MYBPOL,IMPR,IRET) 262 : IF (IRET.NE.0) GOTO 9999 263 : * On rajoute la bulle (\ksi \eta \zeta \lambda avec 264 : * \lambda=1-\ksi-\eta-\zeta) 264 : CALL GPOBUL(3,MYBPOL,IMPR,IRET) 265 : IF (IRET.NE.0) GOTO 9999 266 : ELCOUR.MBPOLY=MYBPOL 267 : SEGDES ELCOUR 268 : MYLRFS.LISEL(**)=ELCOUR 269 : * 270 : * Elément de nom : H1D2TE10 271 : * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation 272 : * nodale, espace de référence de dimension 3, 10 noeuds, 10 degrés de 273 : * liberté, degré de l'approximation : 2, degré du polynôme 274 : * d'interpolation 2 275 : * 276 : * In INILRF : SEGINI ELCOUR 276 : CALL INILRF('H1D2TE10','TETRAEDRE','LAGRANGE','H1', 277 : $ 3,10,10,2, 278 : $ ELCOUR, 279 : $ IMPR,IRET) 280 : IF (IRET.NE.0) GOTO 9999 281 : ELCOUR.XCONOD(1,1)=ZERO 282 : ELCOUR.XCONOD(2,1)=ZERO 283 : ELCOUR.XCONOD(3,1)=ZERO 284 : ELCOUR.XCONOD(1,2)=UNS2 285 : ELCOUR.XCONOD(2,2)=ZERO 286 : ELCOUR.XCONOD(3,2)=ZERO 287 : ELCOUR.XCONOD(1,3)=UN 288 : ELCOUR.XCONOD(2,3)=ZERO 289 : ELCOUR.XCONOD(3,3)=ZERO 290 : ELCOUR.XCONOD(1,4)=UNS2 291 : ELCOUR.XCONOD(2,4)=UNS2 292 : ELCOUR.XCONOD(3,4)=ZERO 293 : ELCOUR.XCONOD(1,5)=ZERO 294 : ELCOUR.XCONOD(2,5)=UN 295 : ELCOUR.XCONOD(3,5)=ZERO 296 : ELCOUR.XCONOD(1,6)=ZERO 297 : ELCOUR.XCONOD(2,6)=UNS2 298 : ELCOUR.XCONOD(3,6)=ZERO 299 : ELCOUR.XCONOD(1,7)=ZERO 300 : ELCOUR.XCONOD(2,7)=ZERO 301 : ELCOUR.XCONOD(3,7)=UNS2 302 : ELCOUR.XCONOD(1,8)=UNS2 303 : ELCOUR.XCONOD(2,8)=ZERO 304 : ELCOUR.XCONOD(3,8)=UNS2 305 : ELCOUR.XCONOD(1,9)=ZERO 306 : ELCOUR.XCONOD(2,9)=UNS2 307 : ELCOUR.XCONOD(3,9)=UNS2 308 : ELCOUR.XCONOD(1,10)=ZERO 309 : ELCOUR.XCONOD(2,10)=ZERO 310 : ELCOUR.XCONOD(3,10)=UN 311 : * Les d.d.l. sont aux noeuds 1,...,10 312 : DO 217 INDDL=1,10 313 : ELCOUR.NPQUAF(INDDL)=INDDL 314 : ELCOUR.NUMCMP(INDDL)=1 315 : 217 CONTINUE 316 : * Initialise la correspondance ddl-noeud+ord.der 316 : CALL INILAG(ELCOUR,IMPR,IRET) 317 : IF (IRET.NE.0) GOTO 9999 318 : * Génère une base polynômiale complète (dimension 3, degré 2) 318 : CALL GBAPCO(3,2,MYBPOL,IMPR,IRET) 319 : IF (IRET.NE.0) GOTO 9999 320 : ELCOUR.MBPOLY=MYBPOL 321 : SEGDES ELCOUR 322 : MYLRFS.LISEL(**)=ELCOUR 323 : * 324 : * Elément de nom : H1D2TE15 325 : * Sur un tétraèdre : élément de Lagrange, fonction H1, approximation 326 : * nodale, espace de référence de dimension 3, 15 noeuds, 15 degrés de 327 : * liberté, degré de l'approximation : 2, degré du polynôme 328 : * d'interpolation 4 329 : * 330 : * In INILRF : SEGINI ELCOUR 330 : CALL INILRF('H1D2TE15','TETRAEDRE','LAGRANGE','H1', 331 : $ 3,15,15,2, 332 : $ ELCOUR, 333 : $ IMPR,IRET) 334 : IF (IRET.NE.0) GOTO 9999 335 : ELCOUR.XCONOD(1,1)=ZERO 336 : ELCOUR.XCONOD(2,1)=ZERO 337 : ELCOUR.XCONOD(3,1)=ZERO 338 : ELCOUR.XCONOD(1,2)=UNS2 339 : ELCOUR.XCONOD(2,2)=ZERO 340 : ELCOUR.XCONOD(3,2)=ZERO 341 : ELCOUR.XCONOD(1,3)=UN 342 : ELCOUR.XCONOD(2,3)=ZERO 343 : ELCOUR.XCONOD(3,3)=ZERO 344 : ELCOUR.XCONOD(1,4)=UNS2 345 : ELCOUR.XCONOD(2,4)=UNS2 346 : ELCOUR.XCONOD(3,4)=ZERO 347 : ELCOUR.XCONOD(1,5)=ZERO 348 : ELCOUR.XCONOD(2,5)=UN 349 : ELCOUR.XCONOD(3,5)=ZERO 350 : ELCOUR.XCONOD(1,6)=ZERO 351 : ELCOUR.XCONOD(2,6)=UNS2 352 : ELCOUR.XCONOD(3,6)=ZERO 353 : ELCOUR.XCONOD(1,7)=ZERO 354 : ELCOUR.XCONOD(2,7)=ZERO 355 : ELCOUR.XCONOD(3,7)=UNS2 356 : ELCOUR.XCONOD(1,8)=UNS2 357 : ELCOUR.XCONOD(2,8)=ZERO 358 : ELCOUR.XCONOD(3,8)=UNS2 359 : ELCOUR.XCONOD(1,9)=ZERO 360 : ELCOUR.XCONOD(2,9)=UNS2 361 : ELCOUR.XCONOD(3,9)=UNS2 362 : ELCOUR.XCONOD(1,10)=ZERO 363 : ELCOUR.XCONOD(2,10)=ZERO 364 : ELCOUR.XCONOD(3,10)=UN 365 : ELCOUR.XCONOD(1,11)=UNS3 366 : ELCOUR.XCONOD(2,11)=UNS3 367 : ELCOUR.XCONOD(3,11)=ZERO 368 : ELCOUR.XCONOD(1,12)=UNS3 369 : ELCOUR.XCONOD(2,12)=ZERO 370 : ELCOUR.XCONOD(3,12)=UNS3 371 : ELCOUR.XCONOD(1,13)=UNS3 372 : ELCOUR.XCONOD(2,13)=UNS3 373 : ELCOUR.XCONOD(3,13)=UNS3 374 : ELCOUR.XCONOD(1,14)=ZERO 375 : ELCOUR.XCONOD(2,14)=UNS3 376 : ELCOUR.XCONOD(3,14)=UNS3 377 : ELCOUR.XCONOD(1,15)=UNS4 378 : ELCOUR.XCONOD(2,15)=UNS4 379 : ELCOUR.XCONOD(3,15)=UNS4 380 : * Les d.d.l. sont aux noeuds 1,...,15 381 : DO 219 INDDL=1,15 382 : ELCOUR.NPQUAF(INDDL)=INDDL 383 : ELCOUR.NUMCMP(INDDL)=1 384 : 219 CONTINUE 385 : * Initialise la correspondance ddl-noeud+ord.der 385 : CALL INILAG(ELCOUR,IMPR,IRET) 386 : IF (IRET.NE.0) GOTO 9999 387 : * Génère une base polynômiale complète (dimension 3, degré 2) 387 : CALL GBAPCO(3,2,MYBPOL,IMPR,IRET) 388 : IF (IRET.NE.0) GOTO 9999 389 : * On rajoute la bulle (\ksi \eta \zeta \lambda avec 390 : * \lambda=1-\ksi-\eta-\zeta) 390 : CALL GPOBUL(3,MYBPOL,IMPR,IRET) 391 : IF (IRET.NE.0) GOTO 9999 392 : * On rajoute les 4 bulles aux faces (\ksi \eta \zeta \lambda avec 393 : * \lambda=1-\ksi-\eta-\zeta) 393 : CALL GPOFBU(3,MYBPOL,IMPR,IRET) 394 : IF (IRET.NE.0) GOTO 9999 395 : ELCOUR.MBPOLY=MYBPOL 396 : SEGDES ELCOUR 397 : MYLRFS.LISEL(**)=ELCOUR 398 : * 399 : * Normal termination 400 : * 401 : IRET=0 402 : RETURN 403 : * 404 : * Format handling 405 : * 406 : * 407 : * Error handling 408 : * 409 : 9999 CONTINUE 410 : IRET=1 411 : WRITE(IOIMP,*) 'An error was detected in subroutine inelte' 412 : RETURN 413 : * 414 : * End of subroutine INELTE 415 : * 416 : END 417 : 418 : 419 : 420 :
© Cast3M 2003 - All rights reserved.
Disclaimer