1 : C INELTR SOURCE GOUNAND 06/12/19 21:15:26 5612 2 : SUBROUTINE INELTR(MYLRFS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INELTR 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 2, 10 : C de forme triangulaire. 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 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 : 26/07/02, ajout du triangle cubique 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 : L2D0TR1 68 : REAL*8 UNS3 69 : PARAMETER (UNS3=1.D0/3.D0) 70 : * Elément de nom : L2D1TR3 71 : REAL*8 UNS6,DEUXS3 72 : PARAMETER (UNS6=1.D0/6.D0,DEUXS3=2.D0/3.D0) 73 : * Elément de nom : H1D1TR3 74 : REAL*8 ZERO,UN 75 : PARAMETER (ZERO=0.D0,UN=1.D0) 76 : * Elément de nom : H1D2TR6 77 : REAL*8 UNS2 78 : PARAMETER (UNS2=1.D0/2.D0) 79 : * 80 : INTEGER INDDL 81 : * 82 : * Executable statements 83 : * 84 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ineltr' 85 : * 86 : * Elément de nom : L2D0TR1 87 : * Sur un triangle : élément de Lagrange, fonction L2, approximation 88 : * nodale, espace de référence de dimension 2, 1 noeud, 1 degré de 89 : * liberté, degré de l'approximation : 0 90 : * 91 : * In INILRF : SEGINI ELCOUR 91 : CALL INILRF('L2D0TR1','TRIANGLE','LAGRANGE','L2', 92 : $ 2,1,1,0, 93 : $ ELCOUR, 94 : $ IMPR,IRET) 95 : IF (IRET.NE.0) GOTO 9999 96 : ELCOUR.XCONOD(1,1)=UNS3 97 : ELCOUR.XCONOD(2,1)=UNS3 98 : ELCOUR.NPQUAF(1)=7 99 : ELCOUR.NUMCMP(1)=1 100 : * Initialise la correspondance ddl-noeud+ord.der 100 : CALL INILAG(ELCOUR,IMPR,IRET) 101 : IF (IRET.NE.0) GOTO 9999 102 : * Génère une base polynômiale complète (dimension 2, degré 0) 102 : CALL GBAPCO(2,0,MYBPOL,IMPR,IRET) 103 : IF (IRET.NE.0) GOTO 9999 104 : ELCOUR.MBPOLY=MYBPOL 105 : SEGDES ELCOUR 106 : MYLRFS.LISEL(**)=ELCOUR 107 : * 108 : * Elément de nom : L2D1TR3 109 : * Sur un triangle : élément de Lagrange, fonction L2, approximation 110 : * nodale, espace de référence de dimension 2, 3 noeuds, 3 degrés de 111 : * liberté, degré de l'approximation : 1 112 : * 113 : * In INILRF : SEGINI ELCOUR 113 : CALL INILRF('L2D1TR3','L2D1TR3','LAGRANGE','L2', 114 : $ 2,3,3,1, 115 : $ ELCOUR, 116 : $ IMPR,IRET) 117 : IF (IRET.NE.0) GOTO 9999 118 : ELCOUR.XCONOD(1,1)=UNS6 119 : ELCOUR.XCONOD(2,1)=UNS6 120 : ELCOUR.XCONOD(1,2)=DEUXS3 121 : ELCOUR.XCONOD(2,2)=UNS6 122 : ELCOUR.XCONOD(1,3)=UNS6 123 : ELCOUR.XCONOD(2,3)=DEUXS3 124 : ELCOUR.NPQUAF(1)=7 125 : ELCOUR.NUMCMP(1)=1 126 : ELCOUR.NPQUAF(2)=7 127 : ELCOUR.NUMCMP(2)=2 128 : ELCOUR.NPQUAF(3)=7 129 : ELCOUR.NUMCMP(3)=3 130 : * Initialise la correspondance ddl-noeud+ord.der 130 : CALL INILAG(ELCOUR,IMPR,IRET) 131 : IF (IRET.NE.0) GOTO 9999 132 : * Génère une base polynômiale complète (dimension 2, degré 1) 132 : CALL GBAPCO(2,1,MYBPOL,IMPR,IRET) 133 : IF (IRET.NE.0) GOTO 9999 134 : ELCOUR.MBPOLY=MYBPOL 135 : SEGDES ELCOUR 136 : MYLRFS.LISEL(**)=ELCOUR 137 : * 138 : * Elément de nom : H1D1TR3 139 : * Sur un triangle : élément de Lagrange, fonction H1, approximation 140 : * nodale, espace de référence de dimension 2, 3 noeuds, 3 degrés de 141 : * liberté, degré de l'approximation : 1 142 : * 143 : * In INILRF : SEGINI ELCOUR 143 : CALL INILRF('H1D1TR3','TRIANGLE','LAGRANGE','H1', 144 : $ 2,3,3,1, 145 : $ ELCOUR, 146 : $ IMPR,IRET) 147 : IF (IRET.NE.0) GOTO 9999 148 : ELCOUR.XCONOD(1,1)=ZERO 149 : ELCOUR.XCONOD(2,1)=ZERO 150 : ELCOUR.XCONOD(1,2)=UN 151 : ELCOUR.XCONOD(2,2)=ZERO 152 : ELCOUR.XCONOD(1,3)=ZERO 153 : ELCOUR.XCONOD(2,3)=UN 154 : * Les d.d.l. sont aux noeuds 1,3,5 155 : DO 209 INDDL=1,3 156 : ELCOUR.NPQUAF(INDDL)=(2*INDDL)-1 157 : ELCOUR.NUMCMP(INDDL)=1 158 : 209 CONTINUE 159 : * Initialise la correspondance ddl-noeud+ord.der 159 : CALL INILAG(ELCOUR,IMPR,IRET) 160 : IF (IRET.NE.0) GOTO 9999 161 : * Génère une base polynômiale complète (dimension 2, degré 1) 161 : CALL GBAPCO(2,1,MYBPOL,IMPR,IRET) 162 : IF (IRET.NE.0) GOTO 9999 163 : ELCOUR.MBPOLY=MYBPOL 164 : SEGDES ELCOUR 165 : MYLRFS.LISEL(**)=ELCOUR 166 : * 167 : * Elément de nom : CRD1TR3 168 : * Sur un triangle : élément de Lagrange, fonction continue au centre 169 : * des faces, 170 : * approximation nodale, espace de référence de dimension 2, 3 noeuds, 3 171 : * degrés de liberté, degré de l'approximation : 1 172 : * 173 : * In INILRF : SEGINI ELCOUR 173 : CALL INILRF('CRD1TR3','TRIANGLE','LAGRANGE','HFAC', 174 : $ 2,3,3,1, 175 : $ ELCOUR, 176 : $ IMPR,IRET) 177 : IF (IRET.NE.0) GOTO 9999 178 : ELCOUR.XCONOD(1,1)=UNS2 179 : ELCOUR.XCONOD(2,1)=ZERO 180 : ELCOUR.XCONOD(1,2)=UNS2 181 : ELCOUR.XCONOD(2,2)=UNS2 182 : ELCOUR.XCONOD(1,3)=ZERO 183 : ELCOUR.XCONOD(2,3)=UNS2 184 : * Les d.d.l. sont aux noeuds 2,4,6 185 : DO 201 INDDL=1,3 186 : ELCOUR.NPQUAF(INDDL)=2*INDDL 187 : ELCOUR.NUMCMP(INDDL)=1 188 : 201 CONTINUE 189 : * Initialise la correspondance ddl-noeud+ord.der 189 : CALL INILAG(ELCOUR,IMPR,IRET) 190 : IF (IRET.NE.0) GOTO 9999 191 : * Génère une base polynômiale complète (dimension 2, degré 1) 191 : CALL GBAPCO(2,1,MYBPOL,IMPR,IRET) 192 : IF (IRET.NE.0) GOTO 9999 193 : ELCOUR.MBPOLY=MYBPOL 194 : SEGDES ELCOUR 195 : MYLRFS.LISEL(**)=ELCOUR 196 : * 197 : * Elément de nom : H1D1TR4 198 : * Sur un triangle : élément de Lagrange, fonction H1, approximation 199 : * nodale, espace de référence de dimension 2, 4 noeuds, 4 degrés de 200 : * liberté, degré de l'approximation : 1 201 : * 202 : * In INILRF : SEGINI ELCOUR 202 : CALL INILRF('H1D1TR4','TRIANGLE','LAGRANGE','H1', 203 : $ 2,4,4,1, 204 : $ ELCOUR, 205 : $ IMPR,IRET) 206 : IF (IRET.NE.0) GOTO 9999 207 : ELCOUR.XCONOD(1,1)=ZERO 208 : ELCOUR.XCONOD(2,1)=ZERO 209 : ELCOUR.XCONOD(1,2)=UN 210 : ELCOUR.XCONOD(2,2)=ZERO 211 : ELCOUR.XCONOD(1,3)=ZERO 212 : ELCOUR.XCONOD(2,3)=UN 213 : ELCOUR.XCONOD(1,4)=UNS3 214 : ELCOUR.XCONOD(2,4)=UNS3 215 : * Les d.d.l. sont aux noeuds 1,3,5 et 7 216 : DO 202 INDDL=1,4 217 : ELCOUR.NPQUAF(INDDL)=(2*INDDL)-1 218 : ELCOUR.NUMCMP(INDDL)=1 219 : 202 CONTINUE 220 : * Initialise la correspondance ddl-noeud+ord.der 220 : CALL INILAG(ELCOUR,IMPR,IRET) 221 : IF (IRET.NE.0) GOTO 9999 222 : * Génère une base polynômiale complète (dimension 2, degré 1) 222 : CALL GBAPCO(2,1,MYBPOL,IMPR,IRET) 223 : IF (IRET.NE.0) GOTO 9999 224 : * On rajoute la bulle (\ksi \eta \lambda avec \lambda=1-\ksi-\eta) 224 : CALL GPOBUL(2,MYBPOL,IMPR,IRET) 225 : IF (IRET.NE.0) GOTO 9999 226 : ELCOUR.MBPOLY=MYBPOL 227 : SEGDES ELCOUR 228 : MYLRFS.LISEL(**)=ELCOUR 229 : * 230 : * Elément de nom : H1D2TR6 231 : * Sur un triangle : élément de Lagrange, fonction H1, approximation 232 : * nodale, espace de référence de dimension 2, 6 noeuds, 6 degrés de 233 : * liberté, degré de l'approximation : 2 234 : * 235 : * In INILRF : SEGINI ELCOUR 235 : CALL INILRF('H1D2TR6','TRIANGLE','LAGRANGE','H1', 236 : $ 2,6,6,2, 237 : $ ELCOUR, 238 : $ IMPR,IRET) 239 : IF (IRET.NE.0) GOTO 9999 240 : ELCOUR.XCONOD(1,1)=ZERO 241 : ELCOUR.XCONOD(2,1)=ZERO 242 : ELCOUR.XCONOD(1,2)=UNS2 243 : ELCOUR.XCONOD(2,2)=ZERO 244 : ELCOUR.XCONOD(1,3)=UN 245 : ELCOUR.XCONOD(2,3)=ZERO 246 : ELCOUR.XCONOD(1,4)=UNS2 247 : ELCOUR.XCONOD(2,4)=UNS2 248 : ELCOUR.XCONOD(1,5)=ZERO 249 : ELCOUR.XCONOD(2,5)=UN 250 : ELCOUR.XCONOD(1,6)=ZERO 251 : ELCOUR.XCONOD(2,6)=UNS2 252 : * Les d.d.l. sont aux noeuds 1,2,3,4,5,6 253 : DO 207 INDDL=1,6 254 : ELCOUR.NPQUAF(INDDL)=INDDL 255 : ELCOUR.NUMCMP(INDDL)=1 256 : 207 CONTINUE 257 : * Initialise la correspondance ddl-noeud+ord.der 257 : CALL INILAG(ELCOUR,IMPR,IRET) 258 : IF (IRET.NE.0) GOTO 9999 259 : * Génère une base polynômiale complète (dimension 2, degré 2) 259 : CALL GBAPCO(2,2,MYBPOL,IMPR,IRET) 260 : IF (IRET.NE.0) GOTO 9999 261 : ELCOUR.MBPOLY=MYBPOL 262 : SEGDES ELCOUR 263 : MYLRFS.LISEL(**)=ELCOUR 264 : * 265 : * Elément de nom : H1D2TR7 266 : * Sur un triangle : élément de Lagrange, fonction H1, approximation 267 : * nodale, espace de référence de dimension 2, 7 noeuds, 7 degrés de 268 : * liberté, degré de l'approximation : 2 269 : * 270 : * In INILRF : SEGINI ELCOUR 270 : CALL INILRF('H1D2TR7','TRIANGLE','LAGRANGE','H1', 271 : $ 2,7,7,2, 272 : $ ELCOUR, 273 : $ IMPR,IRET) 274 : IF (IRET.NE.0) GOTO 9999 275 : ELCOUR.XCONOD(1,1)=ZERO 276 : ELCOUR.XCONOD(2,1)=ZERO 277 : ELCOUR.XCONOD(1,2)=UNS2 278 : ELCOUR.XCONOD(2,2)=ZERO 279 : ELCOUR.XCONOD(1,3)=UN 280 : ELCOUR.XCONOD(2,3)=ZERO 281 : ELCOUR.XCONOD(1,4)=UNS2 282 : ELCOUR.XCONOD(2,4)=UNS2 283 : ELCOUR.XCONOD(1,5)=ZERO 284 : ELCOUR.XCONOD(2,5)=UN 285 : ELCOUR.XCONOD(1,6)=ZERO 286 : ELCOUR.XCONOD(2,6)=UNS2 287 : ELCOUR.XCONOD(1,7)=UNS3 288 : ELCOUR.XCONOD(2,7)=UNS3 289 : * Les d.d.l. sont aux noeuds 1,2,3,4,5,6,7 290 : DO 208 INDDL=1,7 291 : ELCOUR.NPQUAF(INDDL)=INDDL 292 : ELCOUR.NUMCMP(INDDL)=1 293 : 208 CONTINUE 294 : * Initialise la correspondance ddl-noeud+ord.der 294 : CALL INILAG(ELCOUR,IMPR,IRET) 295 : IF (IRET.NE.0) GOTO 9999 296 : * Génère une base polynômiale complète (dimension 2, degré 2) 296 : CALL GBAPCO(2,2,MYBPOL,IMPR,IRET) 297 : IF (IRET.NE.0) GOTO 9999 298 : * On rajoute la bulle (\ksi \eta \lambda avec \lambda=1-\ksi-\eta) 298 : CALL GPOBUL(2,MYBPOL,IMPR,IRET) 299 : IF (IRET.NE.0) GOTO 9999 300 : ELCOUR.MBPOLY=MYBPOL 301 : SEGDES ELCOUR 302 : MYLRFS.LISEL(**)=ELCOUR 303 : * 304 : * Elément de nom : H1D3TR10 305 : * Sur un triangle : élément de Lagrange, fonction H1, approximation 306 : * nodale, espace de référence de dimension 2, 10 noeuds, 10 degrés de 307 : * liberté, degré de l'approximation : 3 308 : * 309 : * In INILRF : SEGINI ELCOUR 309 : CALL INILRF('H1D3TR10','TRIANGLE','LAGRANGE','H1', 310 : $ 2,10,10,3, 311 : $ ELCOUR, 312 : $ IMPR,IRET) 313 : IF (IRET.NE.0) GOTO 9999 314 : ELCOUR.XCONOD(1,1)=ZERO 315 : ELCOUR.XCONOD(2,1)=ZERO 316 : ELCOUR.XCONOD(1,2)=UNS3 317 : ELCOUR.XCONOD(2,2)=ZERO 318 : ELCOUR.XCONOD(1,3)=DEUXS3 319 : ELCOUR.XCONOD(2,3)=ZERO 320 : ELCOUR.XCONOD(1,4)=UN 321 : ELCOUR.XCONOD(2,4)=ZERO 322 : ELCOUR.XCONOD(1,5)=DEUXS3 323 : ELCOUR.XCONOD(2,5)=UNS3 324 : ELCOUR.XCONOD(1,6)=UNS3 325 : ELCOUR.XCONOD(2,6)=DEUXS3 326 : ELCOUR.XCONOD(1,7)=ZERO 327 : ELCOUR.XCONOD(2,7)=UN 328 : ELCOUR.XCONOD(1,8)=ZERO 329 : ELCOUR.XCONOD(2,8)=DEUXS3 330 : ELCOUR.XCONOD(1,9)=ZERO 331 : ELCOUR.XCONOD(2,9)=UNS3 332 : ELCOUR.XCONOD(1,10)=UNS3 333 : ELCOUR.XCONOD(2,10)=UNS3 334 : * Attention ! Il y a deux degrés de liberté par face 335 : ELCOUR.NPQUAF(1)=1 336 : ELCOUR.NUMCMP(1)=1 337 : ELCOUR.NPQUAF(2)=2 338 : ELCOUR.NUMCMP(2)=1 339 : ELCOUR.NPQUAF(3)=2 340 : ELCOUR.NUMCMP(3)=2 341 : ELCOUR.NPQUAF(4)=3 342 : ELCOUR.NUMCMP(4)=1 343 : ELCOUR.NPQUAF(5)=4 344 : ELCOUR.NUMCMP(5)=1 345 : ELCOUR.NPQUAF(6)=4 346 : ELCOUR.NUMCMP(6)=2 347 : ELCOUR.NPQUAF(7)=5 348 : ELCOUR.NUMCMP(7)=1 349 : ELCOUR.NPQUAF(8)=6 350 : ELCOUR.NUMCMP(8)=1 351 : ELCOUR.NPQUAF(9)=6 352 : ELCOUR.NUMCMP(9)=2 353 : ELCOUR.NPQUAF(10)=7 354 : ELCOUR.NUMCMP(10)=1 355 : * Initialise la correspondance ddl-noeud+ord.der 355 : CALL INILAG(ELCOUR,IMPR,IRET) 356 : IF (IRET.NE.0) GOTO 9999 357 : * Génère une base polynômiale complète (dimension 2, degré 3) 357 : CALL GBAPCO(2,3,MYBPOL,IMPR,IRET) 358 : IF (IRET.NE.0) GOTO 9999 359 : ELCOUR.MBPOLY=MYBPOL 360 : SEGDES ELCOUR 361 : MYLRFS.LISEL(**)=ELCOUR 362 : * 363 : * Elément de nom : H10D0TR1 364 : * Sur un triangle : élément de Lagrange, fonction H1 "bulle" (nulle sur 365 : * les bords, approximation nodale, espace de référence de dimension 2, 366 : * 1 noeud, 1 degré de liberté, degré de l'approximation : 0 ? 367 : * 368 : * In INILRF : SEGINI ELCOUR 368 : CALL INILRF('H10D0TR1','TRIANGLE','LAGRANGE','H10', 369 : $ 2,1,1,0, 370 : $ ELCOUR, 371 : $ IMPR,IRET) 372 : IF (IRET.NE.0) GOTO 9999 373 : ELCOUR.XCONOD(1,1)=UNS3 374 : ELCOUR.XCONOD(2,1)=UNS3 375 : * Le d.d.l. est au noeud 7 376 : ELCOUR.NPQUAF(1)=7 377 : ELCOUR.NUMCMP(1)=1 378 : * Initialise la correspondance ddl-noeud+ord.der 378 : CALL INILAG(ELCOUR,IMPR,IRET) 379 : IF (IRET.NE.0) GOTO 9999 380 : NBPOLY=0 381 : SEGINI MYBPOL 382 : SEGDES MYBPOL 383 : * Génère la bulle (\ksi \eta \lambda avec \lambda=1-\ksi-\eta) 383 : CALL GPOBUL(2,MYBPOL,IMPR,IRET) 384 : IF (IRET.NE.0) GOTO 9999 385 : ELCOUR.MBPOLY=MYBPOL 386 : SEGDES ELCOUR 387 : MYLRFS.LISEL(**)=ELCOUR 388 : * 389 : * Normal termination 390 : * 391 : IRET=0 392 : RETURN 393 : * 394 : * Format handling 395 : * 396 : * 397 : * Error handling 398 : * 399 : 9999 CONTINUE 400 : IRET=1 401 : WRITE(IOIMP,*) 'An error was detected in subroutine ineltr' 402 : RETURN 403 : * 404 : * End of subroutine INELTR 405 : * 406 : END 407 : 408 : 409 : 410 :
© Cast3M 2003 - All rights reserved.
Disclaimer