Télécharger la plaquette Cast3M


fr en

Télécharger ingj20.eso

Retour à la liste

Numérotation des lignes : 

ingj20

  1. C INGJ20    SOURCE    GOUNAND   21/06/02    21:16:46     11022          
  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.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC TNLIN      
  49. *-INC SPOGAU
  50.       POINTEUR MYPGS.POGAUS
  51.       POINTEUR PGCOUR.POGAU
  52. *
  53.       INTEGER IMPR,IRET
  54. *
  55.       INTEGER DIMSRF
  56.       PARAMETER(DIMSRF=1)
  57.       REAL*8 XCOR(DIMSRF)
  58. *
  59. *  Générateurs pour la méthode de Gauss-Jacobi de degré 1 : GJ20-1-1 :
  60. *
  61.       REAL*8 X1D1,P1D1
  62.       PARAMETER (X1D1=0.25D0)
  63.       PARAMETER (P1D1=1.D0/3.D0)
  64. *
  65. *  Générateurs pour la méthode de Gauss-Jacobi de degré 3 : GJ20-3-2 :
  66. *
  67.       REAL*8 X1D3,P1D3,X2D3,P2D3
  68.       PARAMETER (X1D3=0.12251482265544137786674043037115D0)
  69.       PARAMETER (P1D3=0.23254745125350790274997694884235D0)
  70.       PARAMETER (X2D3=0.54415184401122528879992623629551D0)
  71.       PARAMETER (P2D3=0.10078588207982543058335638449098D0)
  72. *
  73. *  Générateurs pour la méthode de Gauss-Jacobi de degré 5 : GJ20-5-3 :
  74. *
  75.       REAL*8 X1D5,P1D5,X2D5,P2D5,X3D5,P3D5
  76.       PARAMETER (X1D5=0.72994024073149732155837979012005D-1)
  77.       PARAMETER (P1D5=0.15713636106488661331834482221327D0)
  78.       PARAMETER (X2D5=0.34700376603835188472176354340395D0)
  79.       PARAMETER (P2D5=0.14624626925986602200351202036424D0)
  80.       PARAMETER (X3D5=0.70500220988849838312239847758405D0)
  81.       PARAMETER (P3D5=0.29950703008580698011476490755826D-1)
  82. *
  83. *  Générateurs pour la méthode de Gauss-Jacobi de degré 7 : GJ20-7-4 :
  84. *
  85.       REAL*8 X1D7,P1D7,X2D7,P2D7,X3D7,P3D7,X4D7,P4D7
  86.       PARAMETER (X1D7=0.48500549446997329297067257098986D-1)
  87.       PARAMETER (P1D7=0.11088841561127798368323131746895D0)
  88.       PARAMETER (X2D7=0.23860073755186230505898141272470D0)
  89.       PARAMETER (P2D7=0.14345878979921420904832801427594D0)
  90.       PARAMETER (X3D7=0.51704729510436750234057336938307D0)
  91.       PARAMETER (P3D7=0.68633887172923075317376345041811D-1)
  92.       PARAMETER (X4D7=0.79585141789677286330337796079324D0)
  93.       PARAMETER (P4D7=0.10352240749918065284397656546638D-1)
  94. *
  95. *  Générateurs pour la méthode de Gauss-Jacobi de degré 9 : GJ20-9-5 :
  96. *
  97.       REAL*8 X1D9,P1D9,X2D9,P2D9,X3D9,P3D9,X4D9,P4D9,X5D9,P5D9
  98.       PARAMETER (X1D9=0.34578939918215091524457428631527D-1)
  99.       PARAMETER (P1D9=0.81764784285770917904880732922335D-1)
  100.       PARAMETER (X2D9=0.17348032077169572310459241798618D0)
  101.       PARAMETER (P2D9=0.12619896189991148802883293516466D0)
  102.       PARAMETER (X3D9=0.38988638706551932824089541038500D0)
  103.       PARAMETER (P3D9=0.89200161221590000186254493070382D-1)
  104.       PARAMETER (X4D9=0.63433347263088677234716388892062D0)
  105.       PARAMETER (P4D9=0.32055600722961919254748930556631D-1)
  106.       PARAMETER (X5D9=0.85105421294701641811622418741001D0)
  107.       PARAMETER (P5D9=0.41138252030990079586162416192984D-2)
  108. *
  109. *  Générateurs pour la méthode de Gauss-Jacobi de degré 11 : GJ20-11-6 :
  110. *
  111.       REAL*8 X1D11,P1D11,X2D11,P2D11,X3D11,P3D11
  112.       REAL*8 X4D11,P4D11,X5D11,P5D11,X6D11,P6D11
  113.       PARAMETER (X1D11=0.25904555093667192754643606997233D-1)
  114.       PARAMETER (P1D11=0.62538702726580937878526556468326D-1)
  115.       PARAMETER (X2D11=0.13156394165798513398691085074097D0)
  116.       PARAMETER (P2D11=0.10737649973678063260575568234795D0)
  117.       PARAMETER (X3D11=0.30243691802289123274990557791855D0)
  118.       PARAMETER (P3D11=0.94577186748541203568292051720050D-1)
  119.       PARAMETER (X4D11=0.50903641316475208401103990516772D0)
  120.       PARAMETER (P4D11=0.51289571129616210220129325076918D-1)
  121.       PARAMETER (X5D11=0.71568112731171391876766262459361D0)
  122.       PARAMETER (P5D11=0.15720297184945051327851262130019D-1)
  123.       PARAMETER (X6D11=0.88680561617756186630126600601049D0)
  124.       PARAMETER (P6D11=0.18310758068692977327784555900563D-2)
  125. *
  126.       INTEGER NOPG
  127. *
  128. * Executable statements
  129. *
  130.       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingj20'
  131. *
  132. * Méthode de nom : GJ20-1-1
  133. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  134. *                  d'ordre 1 à 1 point
  135. *                  espace de référence de dimension 1
  136. *
  137. * In INIPG : SEGINI PGCOUR
  138.       CALL INIPG('GJ20-1-1','GAUSS-JACOBI20','SEGMENT',
  139.      $     1,1,1,
  140.      $     PGCOUR,
  141.      $     IMPR,IRET)
  142.       IF (IRET.NE.0) GOTO 9999
  143.       NOPG=0
  144.       XCOR(1)=X1D1
  145.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D1,IMPR,IRET)
  146.       IF (IRET.NE.0) GOTO 9999
  147.       SEGDES PGCOUR
  148.       MYPGS.LISPG(**)=PGCOUR
  149. *
  150. * Méthode de nom : GJ20-3-2
  151. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  152. *                  d'ordre 3 à 2 points
  153. *                  espace de référence de dimension 1
  154. *
  155. * In INIPG : SEGINI PGCOUR
  156.       CALL INIPG('GJ20-3-2','GAUSS-JACOBI20','SEGMENT',
  157.      $     3,2,1,
  158.      $     PGCOUR,
  159.      $     IMPR,IRET)
  160.       IF (IRET.NE.0) GOTO 9999
  161.       NOPG=0
  162.       XCOR(1)=X1D3
  163.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET)
  164.       IF (IRET.NE.0) GOTO 9999
  165.       XCOR(1)=X2D3
  166.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D3,IMPR,IRET)
  167.       IF (IRET.NE.0) GOTO 9999
  168.       SEGDES PGCOUR
  169.       MYPGS.LISPG(**)=PGCOUR
  170. *
  171. * Méthode de nom : GJ20-5-3
  172. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  173. *                  d'ordre 5 à 3 points
  174. *                  espace de référence de dimension 1
  175. *
  176. * In INIPG : SEGINI PGCOUR
  177.       CALL INIPG('GJ20-5-3','GAUSS-JACOBI20','SEGMENT',
  178.      $     5,3,1,
  179.      $     PGCOUR,
  180.      $     IMPR,IRET)
  181.       IF (IRET.NE.0) GOTO 9999
  182.       NOPG=0
  183.       XCOR(1)=X1D5
  184.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D5,IMPR,IRET)
  185.       IF (IRET.NE.0) GOTO 9999
  186.       XCOR(1)=X2D5
  187.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D5,IMPR,IRET)
  188.       IF (IRET.NE.0) GOTO 9999
  189.       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
  201.       CALL INIPG('GJ20-7-4','GAUSS-JACOBI20','SEGMENT',
  202.      $     7,4,1,
  203.      $     PGCOUR,
  204.      $     IMPR,IRET)
  205.       IF (IRET.NE.0) GOTO 9999
  206.       NOPG=0
  207.       XCOR(1)=X1D7
  208.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D7,IMPR,IRET)
  209.       IF (IRET.NE.0) GOTO 9999
  210.       XCOR(1)=X2D7
  211.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D7,IMPR,IRET)
  212.       IF (IRET.NE.0) GOTO 9999
  213.       XCOR(1)=X3D7
  214.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D7,IMPR,IRET)
  215.       IF (IRET.NE.0) GOTO 9999
  216.       XCOR(1)=X4D7
  217.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D7,IMPR,IRET)
  218.       IF (IRET.NE.0) GOTO 9999
  219.       SEGDES PGCOUR
  220.       MYPGS.LISPG(**)=PGCOUR
  221. *
  222. * Méthode de nom : GJ20-9-5
  223. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  224. *                  d'ordre 9 à 5 points
  225. *                  espace de référence de dimension 1
  226. *
  227. * In INIPG : SEGINI PGCOUR
  228.       CALL INIPG('GJ20-9-5','GAUSS-JACOBI20','SEGMENT',
  229.      $     9,5,1,
  230.      $     PGCOUR,
  231.      $     IMPR,IRET)
  232.       IF (IRET.NE.0) GOTO 9999
  233.       NOPG=0
  234.       XCOR(1)=X1D9
  235.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D9,IMPR,IRET)
  236.       IF (IRET.NE.0) GOTO 9999
  237.       XCOR(1)=X2D9
  238.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D9,IMPR,IRET)
  239.       IF (IRET.NE.0) GOTO 9999
  240.       XCOR(1)=X3D9
  241.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D9,IMPR,IRET)
  242.       IF (IRET.NE.0) GOTO 9999
  243.       XCOR(1)=X4D9
  244.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D9,IMPR,IRET)
  245.       IF (IRET.NE.0) GOTO 9999
  246.       XCOR(1)=X5D9
  247.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D9,IMPR,IRET)
  248.       IF (IRET.NE.0) GOTO 9999
  249.       SEGDES PGCOUR
  250.       MYPGS.LISPG(**)=PGCOUR
  251. *
  252. * Méthode de nom : GJ20-11-6
  253. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  254. *                  d'ordre 11 à 6 points
  255. *                  espace de référence de dimension 1
  256. *
  257. * In INIPG : SEGINI PGCOUR
  258.       CALL INIPG('GJ20-11-6','GAUSS-JACOBI20','SEGMENT',
  259.      $     11,6,1,
  260.      $     PGCOUR,
  261.      $     IMPR,IRET)
  262.       IF (IRET.NE.0) GOTO 9999
  263.       NOPG=0
  264.       XCOR(1)=X1D11
  265.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D11,IMPR,IRET)
  266.       IF (IRET.NE.0) GOTO 9999
  267.       XCOR(1)=X2D11
  268.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D11,IMPR,IRET)
  269.       IF (IRET.NE.0) GOTO 9999
  270.       XCOR(1)=X3D11
  271.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D11,IMPR,IRET)
  272.       IF (IRET.NE.0) GOTO 9999
  273.       XCOR(1)=X4D11
  274.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D11,IMPR,IRET)
  275.       IF (IRET.NE.0) GOTO 9999
  276.       XCOR(1)=X5D11
  277.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D11,IMPR,IRET)
  278.       IF (IRET.NE.0) GOTO 9999
  279.       XCOR(1)=X6D11
  280.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P6D11,IMPR,IRET)
  281.       IF (IRET.NE.0) GOTO 9999
  282.       SEGDES PGCOUR
  283.       MYPGS.LISPG(**)=PGCOUR
  284. *
  285. * Normal termination
  286. *
  287.       IRET=0
  288.       RETURN
  289. *
  290. * Format handling
  291. *
  292. *
  293. * Error handling
  294. *
  295.  9999 CONTINUE
  296.       IRET=1
  297.       WRITE(IOIMP,*) 'An error was detected in subroutine ingj20'
  298.       RETURN
  299. *
  300. * End of subroutine INGJ20
  301. *
  302.       END
  303.  
  304.  
  305.  
  306.  
  307.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales