1 : C INGJ20 SOURCE GOUNAND 05/12/21 21:32:37 5281 2 : SUBROUTINE INGJ20(MYPGS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INGJ20 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 10 : C Gauss-Jacobi (\alpha=2, \beta=0) à une dimension sur 11 : C l'intervalle [0,1] (ordre 1 à 11). 12 : C 13 : C On intègre donc \int_0^1 (1-x)^2 f(x) dx de manière 14 : C approchée. 15 : C 16 : C Ces méthodes sont utilisés pour générer des formules 17 : C produits pour les éléments de type cônes : tétraèdres, 18 : C pyramides. 19 : C 20 : C REFERENCES : Numerical recipes (sous-programme gaujac modifié) 21 : C on a recalculé les poids et points de Gauss en REAL*16 22 : C donc avec environ 32 (plutôt 31) chiffres significatifs 23 : C 24 : C LANGAGE : ESOPE 25 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 26 : C mél : gounand@semt2.smts.cea.fr 27 : C*********************************************************************** 28 : C APPELES : INIPG, GCSINO 29 : C APPELE PAR : INPGS 30 : C*********************************************************************** 31 : C ENTREES : - 32 : C ENTREES/SORTIES : MYPGS (actif en *MOD) 33 : C SORTIES : - 34 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 35 : C*********************************************************************** 36 : C VERSION : v1, 31/05/00, version initiale 37 : C HISTORIQUE : v1, 31/05/00, création 38 : C HISTORIQUE : 39 : C HISTORIQUE : 40 : C*********************************************************************** 41 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 42 : C en cas de modification de ce sous-programme afin de faciliter 43 : C la maintenance ! 44 : C*********************************************************************** 45 : -INC CCOPTIO 46 : CBEGININCLUDE SPOGAU 47 : SEGMENT POGAU 48 : CHARACTER*(LNNPG) NOMPG 49 : CHARACTER*(LNTPG) TYPMPG 50 : CHARACTER*(LNFPG) FORLPG 51 : INTEGER NORDPG 52 : REAL*8 XCOPG(NDLPG,NBPG) 53 : REAL*8 XPOPG(NBPG) 54 : ENDSEGMENT 55 : SEGMENT POGAUS 56 : POINTEUR LISPG(0).POGAU 57 : ENDSEGMENT 58 : CENDINCLUDE SPOGAU 59 : POINTEUR MYPGS.POGAUS 60 : POINTEUR PGCOUR.POGAU 61 : * 62 : INTEGER IMPR,IRET 63 : * 64 : INTEGER DIMSRF 65 : PARAMETER(DIMSRF=1) 66 : REAL*8 XCOR(DIMSRF) 67 : * 68 : * Générateurs pour la méthode de Gauss-Jacobi de degré 1 : GJ20-1-1 : 69 : * 70 : REAL*8 X1D1,P1D1 71 : PARAMETER (X1D1=0.25D0) 72 : PARAMETER (P1D1=1.D0/3.D0) 73 : * 74 : * Générateurs pour la méthode de Gauss-Jacobi de degré 3 : GJ20-3-2 : 75 : * 76 : REAL*8 X1D3,P1D3,X2D3,P2D3 77 : PARAMETER (X1D3=0.12251482265544137786674043037115D0) 78 : PARAMETER (P1D3=0.23254745125350790274997694884235D0) 79 : PARAMETER (X2D3=0.54415184401122528879992623629551D0) 80 : PARAMETER (P2D3=0.10078588207982543058335638449098D0) 81 : * 82 : * Générateurs pour la méthode de Gauss-Jacobi de degré 5 : GJ20-5-3 : 83 : * 84 : REAL*8 X1D5,P1D5,X2D5,P2D5,X3D5,P3D5 85 : PARAMETER (X1D5=0.72994024073149732155837979012005D-1) 86 : PARAMETER (P1D5=0.15713636106488661331834482221327D0) 87 : PARAMETER (X2D5=0.34700376603835188472176354340395D0) 88 : PARAMETER (P2D5=0.14624626925986602200351202036424D0) 89 : PARAMETER (X3D5=0.70500220988849838312239847758405D0) 90 : PARAMETER (P3D5=0.29950703008580698011476490755826D-1) 91 : * 92 : * Générateurs pour la méthode de Gauss-Jacobi de degré 7 : GJ20-7-4 : 93 : * 94 : REAL*8 X1D7,P1D7,X2D7,P2D7,X3D7,P3D7,X4D7,P4D7 95 : PARAMETER (X1D7=0.48500549446997329297067257098986D-1) 96 : PARAMETER (P1D7=0.11088841561127798368323131746895D0) 97 : PARAMETER (X2D7=0.23860073755186230505898141272470D0) 98 : PARAMETER (P2D7=0.14345878979921420904832801427594D0) 99 : PARAMETER (X3D7=0.51704729510436750234057336938307D0) 100 : PARAMETER (P3D7=0.68633887172923075317376345041811D-1) 101 : PARAMETER (X4D7=0.79585141789677286330337796079324D0) 102 : PARAMETER (P4D7=0.10352240749918065284397656546638D-1) 103 : * 104 : * Générateurs pour la méthode de Gauss-Jacobi de degré 9 : GJ20-9-5 : 105 : * 106 : REAL*8 X1D9,P1D9,X2D9,P2D9,X3D9,P3D9,X4D9,P4D9,X5D9,P5D9 107 : PARAMETER (X1D9=0.34578939918215091524457428631527D-1) 108 : PARAMETER (P1D9=0.81764784285770917904880732922335D-1) 109 : PARAMETER (X2D9=0.17348032077169572310459241798618D0) 110 : PARAMETER (P2D9=0.12619896189991148802883293516466D0) 111 : PARAMETER (X3D9=0.38988638706551932824089541038500D0) 112 : PARAMETER (P3D9=0.89200161221590000186254493070382D-1) 113 : PARAMETER (X4D9=0.63433347263088677234716388892062D0) 114 : PARAMETER (P4D9=0.32055600722961919254748930556631D-1) 115 : PARAMETER (X5D9=0.85105421294701641811622418741001D0) 116 : PARAMETER (P5D9=0.41138252030990079586162416192984D-2) 117 : * 118 : * Générateurs pour la méthode de Gauss-Jacobi de degré 11 : GJ20-11-6 : 119 : * 120 : REAL*8 X1D11,P1D11,X2D11,P2D11,X3D11,P3D11 121 : REAL*8 X4D11,P4D11,X5D11,P5D11,X6D11,P6D11 122 : PARAMETER (X1D11=0.25904555093667192754643606997233D-1) 123 : PARAMETER (P1D11=0.62538702726580937878526556468326D-1) 124 : PARAMETER (X2D11=0.13156394165798513398691085074097D0) 125 : PARAMETER (P2D11=0.10737649973678063260575568234795D0) 126 : PARAMETER (X3D11=0.30243691802289123274990557791855D0) 127 : PARAMETER (P3D11=0.94577186748541203568292051720050D-1) 128 : PARAMETER (X4D11=0.50903641316475208401103990516772D0) 129 : PARAMETER (P4D11=0.51289571129616210220129325076918D-1) 130 : PARAMETER (X5D11=0.71568112731171391876766262459361D0) 131 : PARAMETER (P5D11=0.15720297184945051327851262130019D-1) 132 : PARAMETER (X6D11=0.88680561617756186630126600601049D0) 133 : PARAMETER (P6D11=0.18310758068692977327784555900563D-2) 134 : * 135 : INTEGER NOPG 136 : * 137 : * Executable statements 138 : * 139 : IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingj20' 140 : * 141 : * Méthode de nom : GJ20-1-1 142 : * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0 143 : * d'ordre 1 à 1 point 144 : * espace de référence de dimension 1 145 : * 146 : * In INIPG : SEGINI PGCOUR 146 : CALL INIPG('GJ20-1-1','GAUSS-JACOBI20','SEGMENT', 147 : $ 1,1,1, 148 : $ PGCOUR, 149 : $ IMPR,IRET) 150 : IF (IRET.NE.0) GOTO 9999 151 : NOPG=0 152 : XCOR(1)=X1D1 152 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D1,IMPR,IRET) 153 : IF (IRET.NE.0) GOTO 9999 154 : SEGDES PGCOUR 155 : MYPGS.LISPG(**)=PGCOUR 156 : * 157 : * Méthode de nom : GJ20-3-2 158 : * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0 159 : * d'ordre 3 à 2 points 160 : * espace de référence de dimension 1 161 : * 162 : * In INIPG : SEGINI PGCOUR 162 : CALL INIPG('GJ20-3-2','GAUSS-JACOBI20','SEGMENT', 163 : $ 3,2,1, 164 : $ PGCOUR, 165 : $ IMPR,IRET) 166 : IF (IRET.NE.0) GOTO 9999 167 : NOPG=0 168 : XCOR(1)=X1D3 168 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET) 169 : IF (IRET.NE.0) GOTO 9999 170 : XCOR(1)=X2D3 170 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D3,IMPR,IRET) 171 : IF (IRET.NE.0) GOTO 9999 172 : SEGDES PGCOUR 173 : MYPGS.LISPG(**)=PGCOUR 174 : * 175 : * Méthode de nom : GJ20-5-3 176 : * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0 177 : * d'ordre 5 à 3 points 178 : * espace de référence de dimension 1 179 : * 180 : * In INIPG : SEGINI PGCOUR 180 : CALL INIPG('GJ20-5-3','GAUSS-JACOBI20','SEGMENT', 181 : $ 5,3,1, 182 : $ PGCOUR, 183 : $ IMPR,IRET) 184 : IF (IRET.NE.0) GOTO 9999 185 : NOPG=0 186 : XCOR(1)=X1D5 186 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D5,IMPR,IRET) 187 : IF (IRET.NE.0) GOTO 9999 188 : XCOR(1)=X2D5 188 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D5,IMPR,IRET) 189 : IF (IRET.NE.0) GOTO 9999 190 : XCOR(1)=X3D5 190 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D5,IMPR,IRET) 191 : IF (IRET.NE.0) GOTO 9999 192 : SEGDES PGCOUR 193 : MYPGS.LISPG(**)=PGCOUR 194 : * 195 : * Méthode de nom : GJ20-7-4 196 : * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0 197 : * d'ordre 7 à 4 points 198 : * espace de référence de dimension 1 199 : * 200 : * In INIPG : SEGINI PGCOUR 200 : CALL INIPG('GJ20-7-4','GAUSS-JACOBI20','SEGMENT', 201 : $ 7,4,1, 202 : $ PGCOUR, 203 : $ IMPR,IRET) 204 : IF (IRET.NE.0) GOTO 9999 205 : NOPG=0 206 : XCOR(1)=X1D7 206 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D7,IMPR,IRET) 207 : IF (IRET.NE.0) GOTO 9999 208 : XCOR(1)=X2D7 208 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D7,IMPR,IRET) 209 : IF (IRET.NE.0) GOTO 9999 210 : XCOR(1)=X3D7 210 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D7,IMPR,IRET) 211 : IF (IRET.NE.0) GOTO 9999 212 : XCOR(1)=X4D7 212 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D7,IMPR,IRET) 213 : IF (IRET.NE.0) GOTO 9999 214 : SEGDES PGCOUR 215 : MYPGS.LISPG(**)=PGCOUR 216 : * 217 : * Méthode de nom : GJ20-9-5 218 : * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0 219 : * d'ordre 9 à 5 points 220 : * espace de référence de dimension 1 221 : * 222 : * In INIPG : SEGINI PGCOUR 222 : CALL INIPG('GJ20-9-5','GAUSS-JACOBI20','SEGMENT', 223 : $ 9,5,1, 224 : $ PGCOUR, 225 : $ IMPR,IRET) 226 : IF (IRET.NE.0) GOTO 9999 227 : NOPG=0 228 : XCOR(1)=X1D9 228 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D9,IMPR,IRET) 229 : IF (IRET.NE.0) GOTO 9999 230 : XCOR(1)=X2D9 230 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D9,IMPR,IRET) 231 : IF (IRET.NE.0) GOTO 9999 232 : XCOR(1)=X3D9 232 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D9,IMPR,IRET) 233 : IF (IRET.NE.0) GOTO 9999 234 : XCOR(1)=X4D9 234 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D9,IMPR,IRET) 235 : IF (IRET.NE.0) GOTO 9999 236 : XCOR(1)=X5D9 236 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D9,IMPR,IRET) 237 : IF (IRET.NE.0) GOTO 9999 238 : SEGDES PGCOUR 239 : MYPGS.LISPG(**)=PGCOUR 240 : * 241 : * Méthode de nom : GJ20-11-6 242 : * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0 243 : * d'ordre 11 à 6 points 244 : * espace de référence de dimension 1 245 : * 246 : * In INIPG : SEGINI PGCOUR 246 : CALL INIPG('GJ20-11-6','GAUSS-JACOBI20','SEGMENT', 247 : $ 11,6,1, 248 : $ PGCOUR, 249 : $ IMPR,IRET) 250 : IF (IRET.NE.0) GOTO 9999 251 : NOPG=0 252 : XCOR(1)=X1D11 252 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D11,IMPR,IRET) 253 : IF (IRET.NE.0) GOTO 9999 254 : XCOR(1)=X2D11 254 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D11,IMPR,IRET) 255 : IF (IRET.NE.0) GOTO 9999 256 : XCOR(1)=X3D11 256 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D11,IMPR,IRET) 257 : IF (IRET.NE.0) GOTO 9999 258 : XCOR(1)=X4D11 258 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D11,IMPR,IRET) 259 : IF (IRET.NE.0) GOTO 9999 260 : XCOR(1)=X5D11 260 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D11,IMPR,IRET) 261 : IF (IRET.NE.0) GOTO 9999 262 : XCOR(1)=X6D11 262 : CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P6D11,IMPR,IRET) 263 : IF (IRET.NE.0) GOTO 9999 264 : SEGDES PGCOUR 265 : MYPGS.LISPG(**)=PGCOUR 266 : * 267 : * Normal termination 268 : * 269 : IRET=0 270 : RETURN 271 : * 272 : * Format handling 273 : * 274 : * 275 : * Error handling 276 : * 277 : 9999 CONTINUE 278 : IRET=1 279 : WRITE(IOIMP,*) 'An error was detected in subroutine ingj20' 280 : RETURN 281 : * 282 : * End of subroutine INGJ20 283 : * 284 : END 285 : 286 : 287 :
© Cast3M 2003 - All rights reserved.
Disclaimer