1 : C INGAPR SOURCE GOUNAND 05/12/21 21:31:54 5281 2 : SUBROUTINE INGAPR(MYPGS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INGAPR 7 : C PROJET : Noyau linéaire NLIN 8 : C DESCRIPTION : Remplit le segment des méthodes d'intégration 9 : C avec des méthodes d'intégration numérique de cubature 10 : C type Gauss pour le prisme à base triangulaire 11 : C (ordre 1 à 5). 12 : C 13 : C REFERENCES : cf. INGATR et INGASE car on utilise essentiellement 14 : C des méthodes produit des deux précédentes. 15 : C 16 : C LANGAGE : ESOPE 17 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 18 : C mél : gounand@semt2.smts.cea.fr 19 : C*********************************************************************** 20 : C APPELES : INIPG, FIPG, PROPG 21 : C APPELE PAR : INPGS 22 : C*********************************************************************** 23 : C ENTREES : - 24 : C ENTREES/SORTIES : MYPGS (actif en *MOD) 25 : C SORTIES : - 26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 27 : C*********************************************************************** 28 : C VERSION : v1, 11/05/00, version initiale 29 : C HISTORIQUE : v1, 11/05/00, création 30 : C HISTORIQUE : 31 : C HISTORIQUE : 32 : C*********************************************************************** 33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 34 : C en cas de modification de ce sous-programme afin de faciliter 35 : C la maintenance ! 36 : C*********************************************************************** 37 : -INC CCOPTIO 38 : CBEGININCLUDE SPOGAU 39 : SEGMENT POGAU 40 : CHARACTER*(LNNPG) NOMPG 41 : CHARACTER*(LNTPG) TYPMPG 42 : CHARACTER*(LNFPG) FORLPG 43 : INTEGER NORDPG 44 : REAL*8 XCOPG(NDLPG,NBPG) 45 : REAL*8 XPOPG(NBPG) 46 : ENDSEGMENT 47 : SEGMENT POGAUS 48 : POINTEUR LISPG(0).POGAU 49 : ENDSEGMENT 50 : CENDINCLUDE SPOGAU 51 : POINTEUR MYPGS.POGAUS 52 : POINTEUR PGCOUR.POGAU 53 : POINTEUR PGPRO1.POGAU 54 : POINTEUR PGPRO2.POGAU 55 : * 56 : INTEGER IMPR,IRET 57 : * 58 : * 59 : * Executable statements 60 : * 61 : IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingapr' 62 : * 63 : * Méthode de nom : NCPR-1-6 64 : * Sur un prisme : cubature d'ordre 1 à 6 points 65 : * espace de référence de dimension 3 66 : * 67 : * In INIPG : SEGINI PGCOUR 67 : CALL INIPG('NCPR-1-6','NEWTON-COTES','PRISME', 68 : $ 1,6,3, 69 : $ PGCOUR, 70 : $ IMPR,IRET) 71 : IF (IRET.NE.0) GOTO 9999 71 : CALL FIPG('NCT2-1-3',MYPGS,PGPRO1,IMPR,IRET) 72 : IF (IRET.NE.0) GOTO 9999 72 : CALL FIPG('NCC1-1-2',MYPGS,PGPRO2,IMPR,IRET) 73 : IF (IRET.NE.0) GOTO 9999 73 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 74 : IF (IRET.NE.0) GOTO 9999 75 : SEGDES PGCOUR 76 : MYPGS.LISPG(**)=PGCOUR 77 : * 78 : * Méthode de nom : NCPR-3-21 79 : * Sur un prisme : cubature d'ordre 3 à 21 points 80 : * espace de référence de dimension 3 81 : * 82 : * In INIPG : SEGINI PGCOUR 82 : CALL INIPG('NCPR-3-21','NEWTON-COTES','PRISME', 83 : $ 3,21,3, 84 : $ PGCOUR, 85 : $ IMPR,IRET) 86 : IF (IRET.NE.0) GOTO 9999 86 : CALL FIPG('NCT2-3-7',MYPGS,PGPRO1,IMPR,IRET) 87 : IF (IRET.NE.0) GOTO 9999 87 : CALL FIPG('NCC1-3-3',MYPGS,PGPRO2,IMPR,IRET) 88 : IF (IRET.NE.0) GOTO 9999 88 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 89 : IF (IRET.NE.0) GOTO 9999 90 : SEGDES PGCOUR 91 : MYPGS.LISPG(**)=PGCOUR 92 : * 93 : * Méthode de nom : GPPR-1-1 94 : * Sur un prisme : méthode gauss-produit d'ordre 1 à 1 point 95 : * espace de référence de dimension 3 96 : * 97 : * In INIPG : SEGINI PGCOUR 97 : CALL INIPG('GPPR-1-1','GAUSS-PRODUIT','PRISME', 98 : $ 1,1,3, 99 : $ PGCOUR, 100 : $ IMPR,IRET) 101 : IF (IRET.NE.0) GOTO 9999 101 : CALL FIPG('GAT2-1-1',MYPGS,PGPRO1,IMPR,IRET) 102 : IF (IRET.NE.0) GOTO 9999 102 : CALL FIPG('GAC1-1-1',MYPGS,PGPRO2,IMPR,IRET) 103 : IF (IRET.NE.0) GOTO 9999 103 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 104 : IF (IRET.NE.0) GOTO 9999 105 : SEGDES PGCOUR 106 : MYPGS.LISPG(**)=PGCOUR 107 : * 108 : * Méthode de nom : GPPR-2-6 109 : * Sur un prisme : méthode gauss-produit d'ordre 2 à 6 points 110 : * espace de référence de dimension 3 111 : * 112 : * In INIPG : SEGINI PGCOUR 112 : CALL INIPG('GPPR-2-6','GAUSS-PRODUIT','PRISME', 113 : $ 2,6,3, 114 : $ PGCOUR, 115 : $ IMPR,IRET) 116 : IF (IRET.NE.0) GOTO 9999 116 : CALL FIPG('GAT2-2-3A',MYPGS,PGPRO1,IMPR,IRET) 117 : IF (IRET.NE.0) GOTO 9999 117 : CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET) 118 : IF (IRET.NE.0) GOTO 9999 118 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 119 : IF (IRET.NE.0) GOTO 9999 120 : SEGDES PGCOUR 121 : MYPGS.LISPG(**)=PGCOUR 122 : * 123 : * Méthode de nom : GPPR-3-8 124 : * Sur un prisme : méthode gauss-produit d'ordre 3 à 8 points 125 : * espace de référence de dimension 3 126 : * 127 : * In INIPG : SEGINI PGCOUR 127 : CALL INIPG('GPPR-3-8','GAUSS-PRODUIT','PRISME', 128 : $ 3,8,3, 129 : $ PGCOUR, 130 : $ IMPR,IRET) 131 : IF (IRET.NE.0) GOTO 9999 131 : CALL FIPG('GPT2-3-4',MYPGS,PGPRO1,IMPR,IRET) 132 : IF (IRET.NE.0) GOTO 9999 132 : CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET) 133 : IF (IRET.NE.0) GOTO 9999 133 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 134 : IF (IRET.NE.0) GOTO 9999 135 : SEGDES PGCOUR 136 : MYPGS.LISPG(**)=PGCOUR 137 : * 138 : * Méthode de nom : GPPR-4-18 139 : * Sur un prisme : méthode gauss-produit d'ordre 4 à 18 points 140 : * espace de référence de dimension 3 141 : * 142 : * In INIPG : SEGINI PGCOUR 142 : CALL INIPG('GPPR-4-18','GAUSS-PRODUIT','PRISME', 143 : $ 4,18,3, 144 : $ PGCOUR, 145 : $ IMPR,IRET) 146 : IF (IRET.NE.0) GOTO 9999 146 : CALL FIPG('GAT2-4-6A',MYPGS,PGPRO1,IMPR,IRET) 147 : IF (IRET.NE.0) GOTO 9999 147 : CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET) 148 : IF (IRET.NE.0) GOTO 9999 148 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 149 : IF (IRET.NE.0) GOTO 9999 150 : SEGDES PGCOUR 151 : MYPGS.LISPG(**)=PGCOUR 152 : * 153 : * Méthode de nom : GPPR-5-21 154 : * Sur un prisme : méthode gauss-produit d'ordre 5 à 21 points 155 : * espace de référence de dimension 3 156 : * 157 : * In INIPG : SEGINI PGCOUR 157 : CALL INIPG('GPPR-5-21','GAUSS-PRODUIT','PRISME', 158 : $ 5,21,3, 159 : $ PGCOUR, 160 : $ IMPR,IRET) 161 : IF (IRET.NE.0) GOTO 9999 161 : CALL FIPG('GAT2-5-7',MYPGS,PGPRO1,IMPR,IRET) 162 : IF (IRET.NE.0) GOTO 9999 162 : CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET) 163 : IF (IRET.NE.0) GOTO 9999 163 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 164 : IF (IRET.NE.0) GOTO 9999 165 : SEGDES PGCOUR 166 : MYPGS.LISPG(**)=PGCOUR 167 : * 168 : * Méthode de nom : GPPR-7-48 169 : * Sur un prisme : méthode gauss-produit d'ordre 7 à 48 points 170 : * espace de référence de dimension 3 171 : * 172 : * In INIPG : SEGINI PGCOUR 172 : CALL INIPG('GPPR-7-48','GAUSS-PRODUIT','PRISME', 173 : $ 7,48,3, 174 : $ PGCOUR, 175 : $ IMPR,IRET) 176 : IF (IRET.NE.0) GOTO 9999 176 : CALL FIPG('GAT2-7-12',MYPGS,PGPRO1,IMPR,IRET) 177 : IF (IRET.NE.0) GOTO 9999 177 : CALL FIPG('GAC1-7-4',MYPGS,PGPRO2,IMPR,IRET) 178 : IF (IRET.NE.0) GOTO 9999 178 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 179 : IF (IRET.NE.0) GOTO 9999 180 : SEGDES PGCOUR 181 : MYPGS.LISPG(**)=PGCOUR 182 : * 183 : * Normal termination 184 : * 185 : IRET=0 186 : RETURN 187 : * 188 : * Format handling 189 : * 190 : * 191 : * Error handling 192 : * 193 : 9999 CONTINUE 194 : IRET=1 195 : WRITE(IOIMP,*) 'An error was detected in subroutine ingapr' 196 : RETURN 197 : * 198 : * End of subroutine INGAPR 199 : * 200 : END 201 : 202 : 203 :
© Cast3M 2003 - All rights reserved.
Disclaimer