1 : C INGACU SOURCE PV 07/11/23 21:17:16 5978 2 : SUBROUTINE INGACU(MYPGS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INGACU 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 cube (ordre 1 à 5). 11 : C 12 : C REFERENCES : Le site de Cools (avec 32 chiffres sign.) 13 : C (essentiellement Stroud et al.) dont on reprend la 14 : C nomenclature... 15 : C LANGAGE : ESOPE 16 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 17 : C mél : gounand@semt2.smts.cea.fr 18 : C*********************************************************************** 19 : C APPELES : INIPG, GCSINO, GCFS2, GCRESY 20 : C APPELE PAR : INPGS 21 : C*********************************************************************** 22 : C ENTREES : - 23 : C ENTREES/SORTIES : MYPGS (actif en *MOD) 24 : C SORTIES : - 25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 26 : C*********************************************************************** 27 : C VERSION : v1, 11/05/00, version initiale 28 : C HISTORIQUE : v1, 11/05/00, création 29 : C HISTORIQUE : 30 : C HISTORIQUE : 31 : C*********************************************************************** 32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 33 : C en cas de modification de ce sous-programme afin de faciliter 34 : C la maintenance ! 35 : C*********************************************************************** 36 : -INC CCOPTIO 37 : CBEGININCLUDE SPOGAU 38 : SEGMENT POGAU 39 : CHARACTER*(LNNPG) NOMPG 40 : CHARACTER*(LNTPG) TYPMPG 41 : CHARACTER*(LNFPG) FORLPG 42 : INTEGER NORDPG 43 : REAL*8 XCOPG(NDLPG,NBPG) 44 : REAL*8 XPOPG(NBPG) 45 : ENDSEGMENT 46 : SEGMENT POGAUS 47 : POINTEUR LISPG(0).POGAU 48 : ENDSEGMENT 49 : CENDINCLUDE SPOGAU 50 : POINTEUR MYPGS.POGAUS 51 : POINTEUR PGCOUR.POGAU 52 : * 53 : INTEGER IMPR,IRET 54 : integer PGPRO1,PGPRO2 55 : * 56 : INTEGER DIMSRF 57 : PARAMETER(DIMSRF=3) 58 : REAL*8 XCOR(DIMSRF) 59 : * 60 : * Générateurs pour la cubature de degré 1 à 1 point : GAC3-1-1 : 61 : * - [ Fully symmetric ] 62 : REAL*8 X1D1,Y1D1,Z1D1,P1D1 63 : PARAMETER (X1D1=0.D0) 64 : PARAMETER (Y1D1=0.D0) 65 : PARAMETER (Z1D1=0.D0) 66 : PARAMETER (P1D1=8.D0) 67 : * 68 : * Générateurs pour la cubature de degré 3 à 6 points : GAC3-3-6A : 69 : * - [ Fully symmetric ] 70 : REAL*8 X1D3,Y1D3,Z1D3,P1D3 71 : PARAMETER (X1D3=1.D0) 72 : PARAMETER (Y1D3=0.D0) 73 : PARAMETER (Z1D3=0.D0) 74 : PARAMETER (P1D3=4.D0/3.D0) 75 : * 76 : * Générateurs pour la cubature de degré 5 à 14 points : GAC3-5-14 : 77 : * - [ Fully symmetric ] 78 : REAL*8 X1D5,Y1D5,Z1D5,P1D5 79 : PARAMETER (X1D5=0.795822425754221463264548820476135D0) 80 : PARAMETER (Y1D5=0.D0) 81 : PARAMETER (Z1D5=0.D0) 82 : PARAMETER (P1D5=0.886426592797783933518005540166204D0) 83 : * - [ Fully symmetric ] 84 : REAL*8 X2D5,Y2D5,Z2D5,P2D5 85 : PARAMETER (X2D5=0.758786910639328146269034278112267D0) 86 : PARAMETER (Y2D5=0.758786910639328146269034278112267D0) 87 : PARAMETER (Z2D5=0.758786910639328146269034278112267D0) 88 : PARAMETER (P2D5=0.335180055401662049861495844875346D0) 89 : * 90 : INTEGER NOPG 91 : * 92 : * Executable statements 93 : * 94 : IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingacu' 95 : * 96 : * Méthode de nom : NCC3-1-8 97 : * Sur un cube : cubature d'ordre 1 à 8 points 98 : * espace de référence de dimension 3 99 : * 100 : * In INIPG : SEGINI PGCOUR 100 : CALL INIPG('NCC3-1-8','NEWTON-COTES','CUBE', 101 : $ 1,8,3, 102 : $ PGCOUR, 103 : $ IMPR,IRET) 104 : IF (IRET.NE.0) GOTO 9999 104 : CALL FIPG('NCC2-1-4',MYPGS,PGPRO1,IMPR,IRET) 105 : IF (IRET.NE.0) GOTO 9999 105 : CALL FIPG('NCC1-1-2',MYPGS,PGPRO2,IMPR,IRET) 106 : IF (IRET.NE.0) GOTO 9999 106 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 107 : IF (IRET.NE.0) GOTO 9999 108 : SEGDES PGCOUR 109 : MYPGS.LISPG(**)=PGCOUR 110 : * 111 : * Méthode de nom : NCC3-3-27 112 : * Sur un cube : cubature d'ordre 3 à 27 points 113 : * espace de référence de dimension 3 114 : * 115 : * In INIPG : SEGINI PGCOUR 115 : CALL INIPG('NCC3-3-27','NEWTON-COTES','CUBE', 116 : $ 3,27,3, 117 : $ PGCOUR, 118 : $ IMPR,IRET) 119 : IF (IRET.NE.0) GOTO 9999 119 : CALL FIPG('NCC2-3-9',MYPGS,PGPRO1,IMPR,IRET) 120 : IF (IRET.NE.0) GOTO 9999 120 : CALL FIPG('NCC1-3-3',MYPGS,PGPRO2,IMPR,IRET) 121 : IF (IRET.NE.0) GOTO 9999 121 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 122 : IF (IRET.NE.0) GOTO 9999 123 : SEGDES PGCOUR 124 : MYPGS.LISPG(**)=PGCOUR 125 : * 126 : * Méthode de nom : GAC3-1-1 127 : * Sur un cube : cubature d'ordre 1 à 1 point 128 : * espace de référence de dimension 3 129 : * 130 : * In INIPG : SEGINI PGCOUR 130 : CALL INIPG('GAC3-1-1','GAUSS','CUBE', 131 : $ 1,1,3, 132 : $ PGCOUR, 133 : $ IMPR,IRET) 134 : IF (IRET.NE.0) GOTO 9999 135 : NOPG=0 136 : XCOR(1)=X1D1 137 : XCOR(2)=Y1D1 138 : XCOR(3)=Z1D1 138 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D1,IMPR,IRET) 139 : IF (IRET.NE.0) GOTO 9999 140 : SEGDES PGCOUR 141 : MYPGS.LISPG(**)=PGCOUR 142 : * 143 : * Méthode de nom : GAC3-3-6A 144 : * Sur un cube : cubature d'ordre 3 à 6 points 145 : * espace de référence de dimension 3 146 : * 147 : * In INIPG : SEGINI PGCOUR 147 : CALL INIPG('GAC3-3-6A','GAUSS','CUBE', 148 : $ 3,6,3, 149 : $ PGCOUR, 150 : $ IMPR,IRET) 151 : IF (IRET.NE.0) GOTO 9999 152 : NOPG=0 153 : XCOR(1)=X1D3 154 : XCOR(2)=Y1D3 155 : XCOR(3)=Z1D3 155 : CALL GCFS2(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET) 156 : IF (IRET.NE.0) GOTO 9999 157 : SEGDES PGCOUR 158 : MYPGS.LISPG(**)=PGCOUR 159 : * 160 : * Méthode de nom : GPC3-3-8 161 : * Sur un cube : méthode gauss-produit d'ordre 3 à 8 points 162 : * espace de référence de dimension 3 163 : * 164 : * In INIPG : SEGINI PGCOUR 164 : CALL INIPG('GPC3-3-8','GAUSS-PRODUIT','CUBE', 165 : $ 3,8,3, 166 : $ PGCOUR, 167 : $ IMPR,IRET) 168 : IF (IRET.NE.0) GOTO 9999 168 : CALL FIPG('GPC2-3-4',MYPGS,PGPRO1,IMPR,IRET) 169 : IF (IRET.NE.0) GOTO 9999 169 : CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET) 170 : IF (IRET.NE.0) GOTO 9999 170 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 171 : IF (IRET.NE.0) GOTO 9999 172 : SEGDES PGCOUR 173 : MYPGS.LISPG(**)=PGCOUR 174 : * 175 : * Méthode de nom : GAC3-5-14 176 : * Sur un cube : cubature d'ordre 5 à 14 points 177 : * espace de référence de dimension 3 178 : * 179 : * In INIPG : SEGINI PGCOUR 179 : CALL INIPG('GAC3-5-14','GAUSS','CUBE', 180 : $ 5,14,3, 181 : $ PGCOUR, 182 : $ IMPR,IRET) 183 : IF (IRET.NE.0) GOTO 9999 184 : NOPG=0 185 : XCOR(1)=X1D5 186 : XCOR(2)=Y1D5 187 : XCOR(3)=Z1D5 187 : CALL GCFS2(PGCOUR,NOPG,DIMSRF,XCOR,P1D5,IMPR,IRET) 188 : IF (IRET.NE.0) GOTO 9999 189 : XCOR(1)=X2D5 190 : XCOR(2)=Y2D5 191 : XCOR(3)=Z2D5 191 : CALL GCRESY(PGCOUR,NOPG,DIMSRF,XCOR,P2D5,IMPR,IRET) 192 : IF (IRET.NE.0) GOTO 9999 193 : SEGDES PGCOUR 194 : MYPGS.LISPG(**)=PGCOUR 195 : * 196 : * Méthode de nom : GPC3-5-27 197 : * Sur un cube : méthode gauss-produit d'ordre 5 à 27 points 198 : * espace de référence de dimension 3 199 : * 200 : * In INIPG : SEGINI PGCOUR 200 : CALL INIPG('GPC3-5-27','GAUSS-PRODUIT','CUBE', 201 : $ 5,27,3, 202 : $ PGCOUR, 203 : $ IMPR,IRET) 204 : IF (IRET.NE.0) GOTO 9999 204 : CALL FIPG('GPC2-5-9',MYPGS,PGPRO1,IMPR,IRET) 205 : IF (IRET.NE.0) GOTO 9999 205 : CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET) 206 : IF (IRET.NE.0) GOTO 9999 206 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 207 : IF (IRET.NE.0) GOTO 9999 208 : SEGDES PGCOUR 209 : MYPGS.LISPG(**)=PGCOUR 210 : * 211 : * Méthode de nom : GPC3-7-64 212 : * Sur un cube : méthode gauss-produit d'ordre 7 à 64 points 213 : * espace de référence de dimension 3 214 : * 215 : * In INIPG : SEGINI PGCOUR 215 : CALL INIPG('GPC3-7-64','GAUSS-PRODUIT','CUBE', 216 : $ 7,64,3, 217 : $ PGCOUR, 218 : $ IMPR,IRET) 219 : IF (IRET.NE.0) GOTO 9999 219 : CALL FIPG('GPC2-7-16',MYPGS,PGPRO1,IMPR,IRET) 220 : IF (IRET.NE.0) GOTO 9999 220 : CALL FIPG('GAC1-7-4',MYPGS,PGPRO2,IMPR,IRET) 221 : IF (IRET.NE.0) GOTO 9999 221 : CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) 222 : IF (IRET.NE.0) GOTO 9999 223 : SEGDES PGCOUR 224 : MYPGS.LISPG(**)=PGCOUR 225 : * 226 : * Normal termination 227 : * 228 : IRET=0 229 : RETURN 230 : * 231 : * Format handling 232 : * 233 : * 234 : * Error handling 235 : * 236 : 9999 CONTINUE 237 : IRET=1 238 : WRITE(IOIMP,*) 'An error was detected in subroutine ingacu' 239 : RETURN 240 : * 241 : * End of subroutine INGACU 242 : * 243 : END 244 : 245 : 246 : 247 :
© Cast3M 2003 - All rights reserved.
Disclaimer