1 : C INFPGS SOURCE GOUNAND 08/08/08 21:15:18 6142 2 : SUBROUTINE INFPGS(MYFPGS,MYPGS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INFPGS 7 : C PROJET : Noyau linéaire NLIN 8 : C DESCRIPTION : Initialise le segment contenant les informations sur 9 : C l'ensemble des familles de méthodes d'intégration 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 : INIFPG, FILFPG, PRFPG (initialisations, impression) 16 : C APPELE PAR : PRNLI2 17 : C*********************************************************************** 18 : C ENTREES : * MYPGS (type POGAUS) : segment de description 19 : C des méthodes d'intégration. 20 : C ENTREES/SORTIES : - 21 : C SORTIES : * MYFPGS (type FAPGS) : segment de description 22 : C des familles de méthodes d'intégration. 23 : C TRAVAIL : * FACOUR (type FAPG) : famille courante. 24 : C * NBDFA (type ENTIER) : nombre total de familles 25 : C de méthodes d'intégration. 26 : C * INBDFA (type ENTIER) : indice de boucle sur les 27 : C familles de méthodes d'intégration. 28 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 29 : C*********************************************************************** 30 : C VERSION : v1, 16/07/02, version initiale 31 : C HISTORIQUE : v1, 16/07/02, création 32 : C HISTORIQUE : 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 SPOGAU 41 : SEGMENT POGAU 42 : CHARACTER*(LNNPG) NOMPG 43 : CHARACTER*(LNTPG) TYPMPG 44 : CHARACTER*(LNFPG) FORLPG 45 : INTEGER NORDPG 46 : REAL*8 XCOPG(NDLPG,NBPG) 47 : REAL*8 XPOPG(NBPG) 48 : ENDSEGMENT 49 : SEGMENT POGAUS 50 : POINTEUR LISPG(0).POGAU 51 : ENDSEGMENT 52 : CENDINCLUDE SPOGAU 53 : POINTEUR MYPGS.POGAUS 54 : CBEGININCLUDE SFAPG 55 : SEGMENT FAPG 56 : CHARACTER*(LNNFAP) NOMFAP 57 : INTEGER NBQUAF(NBMPG) 58 : POINTEUR MPOGAU(NBMPG).POGAU 59 : ENDSEGMENT 60 : SEGMENT FAPGS 61 : POINTEUR LISFPG(0).FAPG 62 : ENDSEGMENT 63 : CENDINCLUDE SFAPG 64 : POINTEUR MYFPGS.FAPGS 65 : POINTEUR FACOUR.FAPG 66 : * 67 : INTEGER IMPR,IRET 68 : * 69 : INTEGER NBDFA,INBDFA 70 : LOGICAL LAXI 71 : * 72 : * Executable statements 73 : * 74 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans infpgs' 75 : SEGINI MYFPGS 76 : LAXI=(IFOUR.EQ.0) 77 : * 78 : * Famille de nom : GAM1 Gauss pour la masse (éléments linéaires) 79 : * 80 : * In INIFPG : SEGINI FACOUR 80 : CALL INIFPG('GAM1', 81 : $ FACOUR, 82 : $ IMPR,IRET) 83 : IF (IRET.NE.0) GOTO 9999 83 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET) 84 : IF (IRET.NE.0) GOTO 9999 85 : IF (LAXI) THEN 85 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET) 86 : IF (IRET.NE.0) GOTO 9999 87 : ELSE 87 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET) 88 : IF (IRET.NE.0) GOTO 9999 89 : ENDIF 90 : IF (LAXI) THEN 90 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET) 91 : IF (IRET.NE.0) GOTO 9999 92 : ELSE 92 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET) 93 : IF (IRET.NE.0) GOTO 9999 94 : ENDIF 94 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-2-4B',IMPR,IRET) 95 : IF (IRET.NE.0) GOTO 9999 95 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET) 96 : IF (IRET.NE.0) GOTO 9999 96 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET) 97 : IF (IRET.NE.0) GOTO 9999 97 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET) 98 : IF (IRET.NE.0) GOTO 9999 99 : SEGDES FACOUR 100 : MYFPGS.LISFPG(**)=FACOUR 101 : * 102 : * Famille de nom : GAM2 Gauss pour la masse (éléments quadratiques) 103 : * 104 : * In INIFPG : SEGINI FACOUR 104 : CALL INIFPG('GAM2', 105 : $ FACOUR, 106 : $ IMPR,IRET) 107 : IF (IRET.NE.0) GOTO 9999 108 : IF (LAXI) THEN 108 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET) 109 : ELSE 109 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET) 110 : ENDIF 111 : IF (IRET.NE.0) GOTO 9999 111 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET) 112 : IF (IRET.NE.0) GOTO 9999 113 : IF (LAXI) THEN 113 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-7-16',IMPR,IRET) 114 : IF (IRET.NE.0) GOTO 9999 115 : ELSE 115 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET) 116 : IF (IRET.NE.0) GOTO 9999 117 : ENDIF 117 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET) 118 : IF (IRET.NE.0) GOTO 9999 118 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET) 119 : IF (IRET.NE.0) GOTO 9999 119 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET) 120 : IF (IRET.NE.0) GOTO 9999 120 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET) 121 : IF (IRET.NE.0) GOTO 9999 122 : SEGDES FACOUR 123 : MYFPGS.LISFPG(**)=FACOUR 124 : * 125 : * Famille de nom : GAR1 Gauss pour la rigidité (éléments linéaires) 126 : * 127 : * In INIFPG : SEGINI FACOUR 127 : CALL INIFPG('GAR1', 128 : $ FACOUR, 129 : $ IMPR,IRET) 130 : IF (IRET.NE.0) GOTO 9999 130 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET) 131 : IF (IRET.NE.0) GOTO 9999 131 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-1-1',IMPR,IRET) 132 : IF (IRET.NE.0) GOTO 9999 132 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET) 133 : IF (IRET.NE.0) GOTO 9999 133 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-1-1',IMPR,IRET) 134 : IF (IRET.NE.0) GOTO 9999 134 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET) 135 : IF (IRET.NE.0) GOTO 9999 135 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET) 136 : IF (IRET.NE.0) GOTO 9999 136 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET) 137 : IF (IRET.NE.0) GOTO 9999 138 : SEGDES FACOUR 139 : MYFPGS.LISFPG(**)=FACOUR 140 : * 141 : * Famille de nom : GAR2 Gauss pour la rigidité (éléments quadratiques) 142 : * 143 : * In INIFPG : SEGINI FACOUR 143 : CALL INIFPG('GAR2', 144 : $ FACOUR, 145 : $ IMPR,IRET) 146 : IF (IRET.NE.0) GOTO 9999 147 : IF (LAXI) THEN 147 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET) 148 : ELSE 148 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET) 149 : ENDIF 150 : IF (IRET.NE.0) GOTO 9999 151 : IF (LAXI) THEN 151 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET) 152 : IF (IRET.NE.0) GOTO 9999 153 : ELSE 153 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET) 154 : IF (IRET.NE.0) GOTO 9999 155 : ENDIF 155 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET) 156 : IF (IRET.NE.0) GOTO 9999 156 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET) 157 : IF (IRET.NE.0) GOTO 9999 157 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET) 158 : IF (IRET.NE.0) GOTO 9999 158 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET) 159 : IF (IRET.NE.0) GOTO 9999 159 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET) 160 : IF (IRET.NE.0) GOTO 9999 161 : SEGDES FACOUR 162 : MYFPGS.LISFPG(**)=FACOUR 163 : * 164 : * Famille de nom : NC1 Newton-Cotes 165 : * Méthodes d'intégration d'ordre au moins 1 166 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 167 : * 168 : * In INIFPG : SEGINI FACOUR 168 : CALL INIFPG('NC1 ', 169 : $ FACOUR, 170 : $ IMPR,IRET) 171 : IF (IRET.NE.0) GOTO 9999 171 : CALL FILFPG(FACOUR,MYPGS,'SEG3','NCC1-1-2',IMPR,IRET) 172 : IF (IRET.NE.0) GOTO 9999 172 : CALL FILFPG(FACOUR,MYPGS,'TRI7','NCT2-1-3',IMPR,IRET) 173 : IF (IRET.NE.0) GOTO 9999 173 : CALL FILFPG(FACOUR,MYPGS,'QUA9','NCC2-1-4',IMPR,IRET) 174 : IF (IRET.NE.0) GOTO 9999 174 : CALL FILFPG(FACOUR,MYPGS,'TE15','NCT3-1-4',IMPR,IRET) 175 : IF (IRET.NE.0) GOTO 9999 175 : CALL FILFPG(FACOUR,MYPGS,'PY19','NCPY-0-5',IMPR,IRET) 176 : IF (IRET.NE.0) GOTO 9999 176 : CALL FILFPG(FACOUR,MYPGS,'PR21','NCPR-1-6',IMPR,IRET) 177 : IF (IRET.NE.0) GOTO 9999 177 : CALL FILFPG(FACOUR,MYPGS,'CU27','NCC3-1-8',IMPR,IRET) 178 : IF (IRET.NE.0) GOTO 9999 179 : SEGDES FACOUR 180 : MYFPGS.LISFPG(**)=FACOUR 181 : * 182 : * Famille de nom : NC3 Newton-Cotes 183 : * Méthodes d'intégration d'ordre au moins 3 184 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 185 : * In INIFPG : SEGINI FACOUR 185 : CALL INIFPG('NC3 ', 186 : $ FACOUR, 187 : $ IMPR,IRET) 188 : IF (IRET.NE.0) GOTO 9999 188 : CALL FILFPG(FACOUR,MYPGS,'SEG3','NCC1-3-3',IMPR,IRET) 189 : IF (IRET.NE.0) GOTO 9999 189 : CALL FILFPG(FACOUR,MYPGS,'TRI7','NCT2-3-7',IMPR,IRET) 190 : IF (IRET.NE.0) GOTO 9999 190 : CALL FILFPG(FACOUR,MYPGS,'QUA9','NCC2-3-9',IMPR,IRET) 191 : IF (IRET.NE.0) GOTO 9999 192 : * Pas vraiment du Newton-Cotes, mais je ne sais pas quoi mettre 192 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET) 193 : IF (IRET.NE.0) GOTO 9999 193 : CALL FILFPG(FACOUR,MYPGS,'PR21','NCPR-3-21',IMPR,IRET) 194 : IF (IRET.NE.0) GOTO 9999 194 : CALL FILFPG(FACOUR,MYPGS,'CU27','NCC3-3-27',IMPR,IRET) 195 : IF (IRET.NE.0) GOTO 9999 196 : SEGDES FACOUR 197 : MYFPGS.LISFPG(**)=FACOUR 198 : * 199 : * Famille de nom : GAU1 200 : * Méthodes d'intégration d'ordre au moins 1 201 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 202 : * 203 : * In INIFPG : SEGINI FACOUR 203 : CALL INIFPG('GAU1', 204 : $ FACOUR, 205 : $ IMPR,IRET) 206 : IF (IRET.NE.0) GOTO 9999 206 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-1-1',IMPR,IRET) 207 : IF (IRET.NE.0) GOTO 9999 207 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-1-1',IMPR,IRET) 208 : IF (IRET.NE.0) GOTO 9999 208 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-1-1',IMPR,IRET) 209 : IF (IRET.NE.0) GOTO 9999 209 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-1-1',IMPR,IRET) 210 : IF (IRET.NE.0) GOTO 9999 210 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-1-1',IMPR,IRET) 211 : IF (IRET.NE.0) GOTO 9999 211 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-1-1',IMPR,IRET) 212 : IF (IRET.NE.0) GOTO 9999 212 : CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-1-1',IMPR,IRET) 213 : IF (IRET.NE.0) GOTO 9999 214 : SEGDES FACOUR 215 : MYFPGS.LISFPG(**)=FACOUR 216 : * 217 : * Famille de nom : GAU2 218 : * Méthodes d'intégration d'ordre au moins 2 219 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 220 : * 221 : * In INIFPG : SEGINI FACOUR 221 : CALL INIFPG('GAU2', 222 : $ FACOUR, 223 : $ IMPR,IRET) 224 : IF (IRET.NE.0) GOTO 9999 224 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET) 225 : IF (IRET.NE.0) GOTO 9999 225 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-2-3A',IMPR,IRET) 226 : IF (IRET.NE.0) GOTO 9999 226 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-2-3',IMPR,IRET) 227 : IF (IRET.NE.0) GOTO 9999 227 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-2-4B',IMPR,IRET) 228 : IF (IRET.NE.0) GOTO 9999 228 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET) 229 : IF (IRET.NE.0) GOTO 9999 229 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET) 230 : IF (IRET.NE.0) GOTO 9999 230 : CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-3-6A',IMPR,IRET) 231 : IF (IRET.NE.0) GOTO 9999 232 : SEGDES FACOUR 233 : MYFPGS.LISFPG(**)=FACOUR 234 : * 235 : * Famille de nom : GAU3 236 : * Méthodes d'intégration d'ordre au moins 3 237 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 238 : * 239 : * In INIFPG : SEGINI FACOUR 239 : CALL INIFPG('GAU3', 240 : $ FACOUR, 241 : $ IMPR,IRET) 242 : IF (IRET.NE.0) GOTO 9999 242 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET) 243 : IF (IRET.NE.0) GOTO 9999 243 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET) 244 : IF (IRET.NE.0) GOTO 9999 244 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-3-4A',IMPR,IRET) 245 : IF (IRET.NE.0) GOTO 9999 245 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET) 246 : IF (IRET.NE.0) GOTO 9999 246 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET) 247 : IF (IRET.NE.0) GOTO 9999 247 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-3-8',IMPR,IRET) 248 : IF (IRET.NE.0) GOTO 9999 248 : CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-3-6A',IMPR,IRET) 249 : IF (IRET.NE.0) GOTO 9999 250 : SEGDES FACOUR 251 : MYFPGS.LISFPG(**)=FACOUR 252 : * 253 : * Famille de nom : GAU4 254 : * Méthodes d'intégration d'ordre au moins 4 255 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 256 : * 257 : * In INIFPG : SEGINI FACOUR 257 : CALL INIFPG('GAU4', 258 : $ FACOUR, 259 : $ IMPR,IRET) 260 : IF (IRET.NE.0) GOTO 9999 260 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET) 261 : IF (IRET.NE.0) GOTO 9999 261 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-4-6A',IMPR,IRET) 262 : IF (IRET.NE.0) GOTO 9999 262 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-4-6C',IMPR,IRET) 263 : IF (IRET.NE.0) GOTO 9999 263 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-5-14',IMPR,IRET) 264 : IF (IRET.NE.0) GOTO 9999 264 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET) 265 : IF (IRET.NE.0) GOTO 9999 265 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-4-18',IMPR,IRET) 266 : IF (IRET.NE.0) GOTO 9999 266 : CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-5-14',IMPR,IRET) 267 : IF (IRET.NE.0) GOTO 9999 268 : SEGDES FACOUR 269 : MYFPGS.LISFPG(**)=FACOUR 270 : * 271 : * Famille de nom : GAU5 272 : * Méthodes d'intégration d'ordre au moins 5 273 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 274 : * 275 : * In INIFPG : SEGINI FACOUR 275 : CALL INIFPG('GAU5', 276 : $ FACOUR, 277 : $ IMPR,IRET) 278 : IF (IRET.NE.0) GOTO 9999 278 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET) 279 : IF (IRET.NE.0) GOTO 9999 279 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET) 280 : IF (IRET.NE.0) GOTO 9999 280 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-5-7A',IMPR,IRET) 281 : IF (IRET.NE.0) GOTO 9999 281 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-5-14',IMPR,IRET) 282 : IF (IRET.NE.0) GOTO 9999 282 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET) 283 : IF (IRET.NE.0) GOTO 9999 283 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET) 284 : IF (IRET.NE.0) GOTO 9999 284 : CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-5-14',IMPR,IRET) 285 : IF (IRET.NE.0) GOTO 9999 286 : SEGDES FACOUR 287 : MYFPGS.LISFPG(**)=FACOUR 288 : * 289 : * Famille de nom : GAU6 290 : * Méthodes d'intégration d'ordre au moins 6 291 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 292 : * 293 : * In INIFPG : SEGINI FACOUR 293 : CALL INIFPG('GAU6', 294 : $ FACOUR, 295 : $ IMPR,IRET) 296 : IF (IRET.NE.0) GOTO 9999 296 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET) 297 : IF (IRET.NE.0) GOTO 9999 297 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-7-12',IMPR,IRET) 298 : IF (IRET.NE.0) GOTO 9999 298 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-6-10C',IMPR,IRET) 299 : IF (IRET.NE.0) GOTO 9999 299 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-6-24',IMPR,IRET) 300 : IF (IRET.NE.0) GOTO 9999 300 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET) 301 : IF (IRET.NE.0) GOTO 9999 301 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET) 302 : IF (IRET.NE.0) GOTO 9999 303 : SEGDES FACOUR 304 : MYFPGS.LISFPG(**)=FACOUR 305 : * 306 : * Famille de nom : GAU7 307 : * Méthodes d'intégration d'ordre au moins 7 308 : * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube 309 : * 310 : * In INIFPG : SEGINI FACOUR 310 : CALL INIFPG('GAU7', 311 : $ FACOUR, 312 : $ IMPR,IRET) 313 : IF (IRET.NE.0) GOTO 9999 313 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET) 314 : IF (IRET.NE.0) GOTO 9999 314 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-7-12',IMPR,IRET) 315 : IF (IRET.NE.0) GOTO 9999 315 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-7-12A',IMPR,IRET) 316 : IF (IRET.NE.0) GOTO 9999 316 : CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-7-64',IMPR,IRET) 317 : IF (IRET.NE.0) GOTO 9999 317 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET) 318 : IF (IRET.NE.0) GOTO 9999 318 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET) 319 : IF (IRET.NE.0) GOTO 9999 320 : SEGDES FACOUR 321 : MYFPGS.LISFPG(**)=FACOUR 322 : * 323 : * Famille de nom : GAP3 324 : * Méthodes d'intégration produit d'ordre au moins 3 325 : * 3 éléments : segment, triangle, carré 326 : * 327 : * In INIFPG : SEGINI FACOUR 327 : CALL INIFPG('GAP3', 328 : $ FACOUR, 329 : $ IMPR,IRET) 330 : IF (IRET.NE.0) GOTO 9999 330 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET) 331 : IF (IRET.NE.0) GOTO 9999 331 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET) 332 : IF (IRET.NE.0) GOTO 9999 332 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET) 333 : IF (IRET.NE.0) GOTO 9999 333 : CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET) 334 : IF (IRET.NE.0) GOTO 9999 334 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET) 335 : IF (IRET.NE.0) GOTO 9999 335 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-3-8',IMPR,IRET) 336 : IF (IRET.NE.0) GOTO 9999 336 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET) 337 : IF (IRET.NE.0) GOTO 9999 338 : SEGDES FACOUR 339 : MYFPGS.LISFPG(**)=FACOUR 340 : * 341 : * Famille de nom : GAP5 342 : * Méthodes d'intégration produit d'ordre au moins 5 343 : * 3 éléments : segment, triangle, carré 344 : * 345 : * In INIFPG : SEGINI FACOUR 345 : CALL INIFPG('GAP5', 346 : $ FACOUR, 347 : $ IMPR,IRET) 348 : IF (IRET.NE.0) GOTO 9999 348 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET) 349 : IF (IRET.NE.0) GOTO 9999 349 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-5-9',IMPR,IRET) 350 : IF (IRET.NE.0) GOTO 9999 350 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET) 351 : IF (IRET.NE.0) GOTO 9999 351 : CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-5-27',IMPR,IRET) 352 : IF (IRET.NE.0) GOTO 9999 352 : CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET) 353 : IF (IRET.NE.0) GOTO 9999 353 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET) 354 : IF (IRET.NE.0) GOTO 9999 354 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET) 355 : IF (IRET.NE.0) GOTO 9999 356 : SEGDES FACOUR 357 : MYFPGS.LISFPG(**)=FACOUR 358 : * 359 : * Famille de nom : GAP7 360 : * Méthodes d'intégration produit d'ordre au moins 7 361 : * 4 éléments : segment, triangle, carré, tétraèdre 362 : * 363 : * In INIFPG : SEGINI FACOUR 363 : CALL INIFPG('GAP7', 364 : $ FACOUR, 365 : $ IMPR,IRET) 366 : IF (IRET.NE.0) GOTO 9999 366 : CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET) 367 : IF (IRET.NE.0) GOTO 9999 367 : CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-7-16',IMPR,IRET) 368 : IF (IRET.NE.0) GOTO 9999 368 : CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-7-16',IMPR,IRET) 369 : IF (IRET.NE.0) GOTO 9999 369 : CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-7-64',IMPR,IRET) 370 : IF (IRET.NE.0) GOTO 9999 370 : CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET) 371 : IF (IRET.NE.0) GOTO 9999 371 : CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET) 372 : IF (IRET.NE.0) GOTO 9999 373 : SEGDES FACOUR 374 : MYFPGS.LISFPG(**)=FACOUR 375 : * 376 : * Impression finale 377 : * 378 : NBDFA=MYFPGS.LISFPG(/1) 379 : IF (IMPR.GT.1) THEN 380 : *! WRITE(IOIMP,*) 'Nom, QUAF, Meth. integ' 381 : DO 3 INBDFA=1,NBDFA 382 : WRITE(IOIMP,*) 'Famille de méthodes d''intégration ',INBDFA 383 : FACOUR=MYFPGS.LISFPG(INBDFA) 383 : CALL PRFPG(FACOUR,IMPR,IRET) 384 : IF (IRET.NE.0) GOTO 9999 385 : 3 CONTINUE 386 : ENDIF 387 : SEGDES MYFPGS 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 infpgs' 402 : RETURN 403 : * 404 : * End of subroutine INFPGS 405 : * 406 : END 407 : 408 : 409 :
© Cast3M 2003 - All rights reserved.
Disclaimer