1 : C INFALS SOURCE GOUNAND 08/08/08 21:15:00 6142 2 : SUBROUTINE INFALS(MYFALS,MYLRFS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INFALS 7 : C PROJET : Noyau linéaire NLIN 8 : C DESCRIPTION : Initialise le segment contenant les informations sur 9 : C l'ensemble des familles d'éléments de référence 10 : C 11 : C LANGAGE : ESOPE 12 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 13 : C mél : gounand@semt2.smts.cea.fr 14 : C*********************************************************************** 15 : C APPELES : INIFAL, FILFAL, PRFAL (initialisations, impression) 16 : C APPELE PAR : PRNLI2 17 : C*********************************************************************** 18 : C ENTREES : * MYLRFS (type ELREFS) : segment de description 19 : C des éléments de références. 20 : C ENTREES/SORTIES : - 21 : C SORTIES : * MYFALS (type FALRFS) : segment de description 22 : C des familles d'éléments de références. 23 : C TRAVAIL : * FACOUR (type FALRFS) : famille courante. 24 : C * NBDFA (type ENTIER) : nombre total de familles 25 : C d'éléments 26 : C * INBDFA (type ENTIER) : indice de boucle sur les 27 : C familles d'éléments 28 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 29 : C*********************************************************************** 30 : C VERSION : v1, 17/08/99, version initiale 31 : C HISTORIQUE : v1, 17/08/99, création 32 : C HISTORIQUE : 26/07/02, ajout du triangle cubique 33 : C HISTORIQUE : 34 : C*********************************************************************** 35 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 36 : C en cas de modification de ce sous-programme afin de faciliter 37 : C la maintenance ! 38 : C*********************************************************************** 39 : -INC CCOPTIO 40 : CBEGININCLUDE SELREF 41 : SEGMENT ELREF 42 : CHARACTER*(LNNOM) NOMLRF 43 : CHARACTER*(LNFORM) FORME 44 : CHARACTER*(LNTYPL) TYPEL 45 : CHARACTER*(LNESP) ESPACE 46 : INTEGER DEGRE 47 : REAL*8 XCONOD(NDIMEL,NBNOD) 48 : INTEGER NPQUAF(NBDDL) 49 : INTEGER NUMCMP(NBDDL) 50 : INTEGER QUENOD(NBDDL) 51 : INTEGER ORDDER(NDIMEL,NBDDL) 52 : POINTEUR MBPOLY.POLYNS 53 : ENDSEGMENT 54 : SEGMENT ELREFS 55 : POINTEUR LISEL(0).ELREF 56 : ENDSEGMENT 57 : CENDINCLUDE SELREF 58 : POINTEUR MYLRFS.ELREFS 59 : CBEGININCLUDE SFALRF 60 : SEGMENT FALRF 61 : CHARACTER*(LNNFA) NOMFA 62 : INTEGER NUQUAF(NBLRF) 63 : POINTEUR ELEMF(NBLRF).ELREF 64 : ENDSEGMENT 65 : SEGMENT FALRFS 66 : POINTEUR LISFA(0).FALRF 67 : ENDSEGMENT 68 : CENDINCLUDE SFALRF 69 : POINTEUR MYFALS.FALRFS 70 : POINTEUR FACOUR.FALRF 71 : * 72 : INTEGER IMPR,IRET 73 : * 74 : INTEGER NBDFA,INBDFA 75 : * 76 : * Executable statements 77 : * 78 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans infals' 79 : SEGINI MYFALS 80 : * 81 : * Famille de nom : CSTE 82 : * Elément de Lagrange, fonctions L2, approximation nodale, 83 : * degré de l'approximation : 0 84 : * 7 éléments : segment, triangle, carré, tétraèdre, pyramide, 85 : * prisme, cube 86 : * 87 : * In INIFAL : SEGINI FACOUR 87 : CALL INIFAL('CSTE', 88 : $ FACOUR, 89 : $ IMPR,IRET) 90 : IF (IRET.NE.0) GOTO 9999 90 : CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET) 91 : IF (IRET.NE.0) GOTO 9999 91 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D0TR1',IMPR,IRET) 92 : IF (IRET.NE.0) GOTO 9999 92 : CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D0QU1',IMPR,IRET) 93 : IF (IRET.NE.0) GOTO 9999 93 : CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D0TE1',IMPR,IRET) 94 : IF (IRET.NE.0) GOTO 9999 94 : CALL FILFAL(FACOUR,MYLRFS,'PY19','L2D0PY1',IMPR,IRET) 95 : IF (IRET.NE.0) GOTO 9999 95 : CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D0PR1',IMPR,IRET) 96 : IF (IRET.NE.0) GOTO 9999 96 : CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D0CU1',IMPR,IRET) 97 : IF (IRET.NE.0) GOTO 9999 98 : SEGDES FACOUR 99 : MYFALS.LISFA(**)=FACOUR 100 : * 101 : * Famille de nom : LINM (linéaire par morceaux) 102 : * Elément de Lagrange, fonctions L2, approximation nodale, 103 : * degré de l'approximation : 1 104 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 105 : * 106 : * In INIFAL : SEGINI FACOUR 106 : CALL INIFAL('LINM', 107 : $ FACOUR, 108 : $ IMPR,IRET) 109 : IF (IRET.NE.0) GOTO 9999 109 : CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D1SE2',IMPR,IRET) 110 : IF (IRET.NE.0) GOTO 9999 110 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D1TR3',IMPR,IRET) 111 : IF (IRET.NE.0) GOTO 9999 111 : CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D1QU3',IMPR,IRET) 112 : IF (IRET.NE.0) GOTO 9999 112 : CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D1TE4',IMPR,IRET) 113 : IF (IRET.NE.0) GOTO 9999 113 : CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D1PR4',IMPR,IRET) 114 : IF (IRET.NE.0) GOTO 9999 114 : CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D1CU4',IMPR,IRET) 115 : IF (IRET.NE.0) GOTO 9999 116 : SEGDES FACOUR 117 : MYFALS.LISFA(**)=FACOUR 118 : * 119 : * Famille de nom : LINE 120 : * Elément de Lagrange, fonctions H1, approximation nodale, 121 : * degré de l'approximation : 1 122 : * 123 : * 124 : * In INIFAL : SEGINI FACOUR 124 : CALL INIFAL('LINE', 125 : $ FACOUR, 126 : $ IMPR,IRET) 127 : IF (IRET.NE.0) GOTO 9999 127 : CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET) 128 : IF (IRET.NE.0) GOTO 9999 128 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR3',IMPR,IRET) 129 : IF (IRET.NE.0) GOTO 9999 129 : CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D1QU4',IMPR,IRET) 130 : IF (IRET.NE.0) GOTO 9999 130 : CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE4',IMPR,IRET) 131 : IF (IRET.NE.0) GOTO 9999 131 : CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D1PY5',IMPR,IRET) 132 : IF (IRET.NE.0) GOTO 9999 132 : CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D1PR6',IMPR,IRET) 133 : IF (IRET.NE.0) GOTO 9999 133 : CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D1CU8',IMPR,IRET) 134 : IF (IRET.NE.0) GOTO 9999 135 : SEGDES FACOUR 136 : MYFALS.LISFA(**)=FACOUR 137 : * 138 : * Famille de nom : LINC 139 : * Elément de Lagrange, type Crouzeix-Raviart, approximation nodale, 140 : * degré de l'approximation : 1 141 : * 142 : * 143 : * In INIFAL : SEGINI FACOUR 143 : CALL INIFAL('LINC', 144 : $ FACOUR, 145 : $ IMPR,IRET) 146 : IF (IRET.NE.0) GOTO 9999 146 : * CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET) 146 : CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET) 147 : IF (IRET.NE.0) GOTO 9999 147 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','CRD1TR3',IMPR,IRET) 148 : IF (IRET.NE.0) GOTO 9999 148 : CALL FILFAL(FACOUR,MYLRFS,'QUA9','CRD1QU4',IMPR,IRET) 149 : IF (IRET.NE.0) GOTO 9999 149 : CALL FILFAL(FACOUR,MYLRFS,'TE15','CRD1TE4',IMPR,IRET) 150 : IF (IRET.NE.0) GOTO 9999 151 : * 152 : * La pyramide doit être facile à faire, les fonctions de forme 153 : * sont les mêmes que celles de la famille H1. 154 : * Mais cet élément marche-t-il ? Jamais vu dans la littérature 155 : * 155 : * CALL FILFAL(FACOUR,MYLRFS,'PY19','CRD1PY5',IMPR,IRET) 156 : * IF (IRET.NE.0) GOTO 9999 156 : CALL FILFAL(FACOUR,MYLRFS,'PR21','CRD1PR5',IMPR,IRET) 157 : IF (IRET.NE.0) GOTO 9999 157 : CALL FILFAL(FACOUR,MYLRFS,'CU27','CRD1CU6',IMPR,IRET) 158 : IF (IRET.NE.0) GOTO 9999 159 : SEGDES FACOUR 160 : MYFALS.LISFA(**)=FACOUR 161 : * 162 : * Famille de nom : LINB 163 : * Elément de Lagrange simpliciaux + bulle, 164 : * fonctions H1, approximation nodale, 165 : * degré de l'approximation : 1 166 : * 167 : * In INIFAL : SEGINI FACOUR 167 : CALL INIFAL('LINB', 168 : $ FACOUR, 169 : $ IMPR,IRET) 170 : IF (IRET.NE.0) GOTO 9999 170 : CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET) 171 : IF (IRET.NE.0) GOTO 9999 171 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR4',IMPR,IRET) 172 : IF (IRET.NE.0) GOTO 9999 172 : CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE5',IMPR,IRET) 173 : IF (IRET.NE.0) GOTO 9999 174 : SEGDES FACOUR 175 : MYFALS.LISFA(**)=FACOUR 176 : * 177 : * Famille de nom : QUAI 178 : * Elément de Lagrange incomplets, fonctions H1, approximation nodale, 179 : * degré de l'approximation : 2 180 : * 181 : * In INIFAL : SEGINI FACOUR 181 : CALL INIFAL('QUAI', 182 : $ FACOUR, 183 : $ IMPR,IRET) 184 : IF (IRET.NE.0) GOTO 9999 184 : CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET) 185 : IF (IRET.NE.0) GOTO 9999 185 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET) 186 : IF (IRET.NE.0) GOTO 9999 186 : CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU8',IMPR,IRET) 187 : IF (IRET.NE.0) GOTO 9999 187 : CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET) 188 : IF (IRET.NE.0) GOTO 9999 188 : CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D2PY13',IMPR,IRET) 189 : IF (IRET.NE.0) GOTO 9999 189 : CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR15',IMPR,IRET) 190 : IF (IRET.NE.0) GOTO 9999 190 : CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU20',IMPR,IRET) 191 : IF (IRET.NE.0) GOTO 9999 192 : SEGDES FACOUR 193 : MYFALS.LISFA(**)=FACOUR 194 : * 195 : * Famille de nom : QUAD 196 : * Elément de Lagrange, fonctions H1, approximation nodale, 197 : * degré de l'approximation : 2 198 : * 199 : * In INIFAL : SEGINI FACOUR 199 : CALL INIFAL('QUAD', 200 : $ FACOUR, 201 : $ IMPR,IRET) 202 : IF (IRET.NE.0) GOTO 9999 202 : CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET) 203 : IF (IRET.NE.0) GOTO 9999 203 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET) 204 : IF (IRET.NE.0) GOTO 9999 204 : CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET) 205 : IF (IRET.NE.0) GOTO 9999 205 : CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET) 206 : IF (IRET.NE.0) GOTO 9999 206 : CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR18',IMPR,IRET) 207 : IF (IRET.NE.0) GOTO 9999 207 : CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET) 208 : IF (IRET.NE.0) GOTO 9999 209 : SEGDES FACOUR 210 : MYFALS.LISFA(**)=FACOUR 211 : * 212 : * Famille de nom : QUAF (Quadratique pour les fluides) 213 : * Elément de Lagrange + bulles éventuelles, fonctions H1, approximation 214 : * nodale, degré de l'approximation : 2 215 : * 216 : * In INIFAL : SEGINI FACOUR 216 : CALL INIFAL('QUAF', 217 : $ FACOUR, 218 : $ IMPR,IRET) 219 : IF (IRET.NE.0) GOTO 9999 219 : CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET) 220 : IF (IRET.NE.0) GOTO 9999 220 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR7',IMPR,IRET) 221 : IF (IRET.NE.0) GOTO 9999 221 : CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET) 222 : IF (IRET.NE.0) GOTO 9999 222 : CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE15',IMPR,IRET) 223 : IF (IRET.NE.0) GOTO 9999 223 : CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR21',IMPR,IRET) 224 : IF (IRET.NE.0) GOTO 9999 224 : CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET) 225 : IF (IRET.NE.0) GOTO 9999 226 : SEGDES FACOUR 227 : MYFALS.LISFA(**)=FACOUR 228 : * 229 : * Famille de nom : CUBI 230 : * Elément de Lagrange, fonctions H1, approximation nodale, 231 : * degré de l'approximation : 3 232 : * 233 : * In INIFAL : SEGINI FACOUR 233 : CALL INIFAL('CUBI', 234 : $ FACOUR, 235 : $ IMPR,IRET) 236 : IF (IRET.NE.0) GOTO 9999 236 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D3TR10',IMPR,IRET) 237 : IF (IRET.NE.0) GOTO 9999 238 : SEGDES FACOUR 239 : MYFALS.LISFA(**)=FACOUR 240 : * 241 : * Famille de nom : BULL 242 : * Elément de Lagrange simpliciaux bulle, 243 : * fonctions H10, approximation nodale, 244 : * degré de l'approximation : 0 245 : * 246 : * In INIFAL : SEGINI FACOUR 246 : CALL INIFAL('BULL', 247 : $ FACOUR, 248 : $ IMPR,IRET) 249 : IF (IRET.NE.0) GOTO 9999 249 : CALL FILFAL(FACOUR,MYLRFS,'TRI7','H10D0TR1',IMPR,IRET) 250 : IF (IRET.NE.0) GOTO 9999 251 : SEGDES FACOUR 252 : MYFALS.LISFA(**)=FACOUR 253 : * 254 : * Impression finale 255 : * 256 : NBDFA=MYFALS.LISFA(/1) 257 : IF (IMPR.GT.1) THEN 258 : DO 3 INBDFA=1,NBDFA 259 : WRITE(IOIMP,*) 'Famille d''éléments de référence ',INBDFA 260 : FACOUR=MYFALS.LISFA(INBDFA) 260 : CALL PRFAL(FACOUR,IMPR,IRET) 261 : IF (IRET.NE.0) GOTO 9999 262 : 3 CONTINUE 263 : ENDIF 264 : SEGDES MYFALS 265 : * 266 : * Normal termination 267 : * 268 : IRET=0 269 : RETURN 270 : * 271 : * Format handling 272 : * 273 : * 274 : * Error handling 275 : * 276 : 9999 CONTINUE 277 : IRET=1 278 : WRITE(IOIMP,*) 'An error was detected in subroutine infals' 279 : RETURN 280 : * 281 : * End of subroutine INFALS 282 : * 283 : END 284 : 285 : 286 : 287 :
© Cast3M 2003 - All rights reserved.
Disclaimer