Télécharger la plaquette Cast3M


fr en

Télécharger ingj10.eso

Retour à la liste

Numérotation des lignes : 

ingj10

  1. C INGJ10    SOURCE    GOUNAND   21/06/02    21:16:45     11022          
  2.       SUBROUTINE INGJ10(MYPGS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INGJ10
  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=1, \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) 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 : triangles.
  18. C
  19. C REFERENCES  : Numerical recipes (sous-programme gaujac modifié)
  20. C               on a recalculé les poids et points de Gauss en REAL*16
  21. C               donc avec environ 32 (plutôt 31) chiffres significatifs
  22. C
  23. C LANGAGE     : ESOPE
  24. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  25. C               mél : gounand@semt2.smts.cea.fr
  26. C***********************************************************************
  27. C APPELES          : INIPG, GCSINO
  28. C APPELE PAR       : INPGS
  29. C***********************************************************************
  30. C ENTREES            : -
  31. C ENTREES/SORTIES    : MYPGS (actif en *MOD)
  32. C SORTIES            : -
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION    : v1, 31/05/00, version initiale
  36. C HISTORIQUE : v1, 31/05/00, création
  37. C HISTORIQUE :
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC TNLIN      
  48. *-INC SPOGAU
  49.       POINTEUR MYPGS.POGAUS
  50.       POINTEUR PGCOUR.POGAU
  51. *
  52.       INTEGER IMPR,IRET
  53. *
  54.       INTEGER DIMSRF
  55.       PARAMETER(DIMSRF=1)
  56.       REAL*8 XCOR(DIMSRF)
  57. *
  58. *  Générateurs pour la méthode de Gauss-Jacobi de degré 1 : GJ10-1-1 :
  59. *
  60.       REAL*8 X1D1,P1D1
  61.       PARAMETER (X1D1=1.D0/3.D0)
  62.       PARAMETER (P1D1=0.5D0)
  63. *
  64. *  Générateurs pour la méthode de Gauss-Jacobi de degré 3 : GJ10-3-2 :
  65. *
  66.       REAL*8 X1D3,P1D3,X2D3,P2D3
  67.       PARAMETER (X1D3=0.15505102572168219018027159252941D0)
  68.       PARAMETER (P1D3=0.31804138174397716939436900207515D0)
  69.       PARAMETER (X2D3=0.64494897427831780981972840747060D0)
  70.       PARAMETER (P2D3=0.18195861825602283060563099792484D0)
  71. *
  72. *  Générateurs pour la méthode de Gauss-Jacobi de degré 5 : GJ10-5-3 :
  73. *
  74.       REAL*8 X1D5,P1D5,X2D5,P2D5,X3D5,P3D5
  75.       PARAMETER (X1D5=0.88587959512703947395546143769455D-1)
  76.       PARAMETER (P1D5=0.20093191373895963077219813326462D0)
  77.       PARAMETER (X2D5=0.40946686444073471086492625206883D0)
  78.       PARAMETER (P2D5=0.22924110635958624669392059455632D0)
  79.       PARAMETER (X3D5=0.78765946176084705602524188987600D0)
  80.       PARAMETER (P3D5=0.69826979901454122533881272179078D-1)
  81. *
  82. *  Générateurs pour la méthode de Gauss-Jacobi de degré 7 : GJ10-7-4 :
  83. *
  84.       REAL*8 X1D7,P1D7,X2D7,P2D7,X3D7,P3D7,X4D7,P4D7
  85.       PARAMETER (X1D7=0.57104196114517682193121192554116D-1)
  86.       PARAMETER (P1D7=0.13550691343148811620826417407793D0)
  87.       PARAMETER (X2D7=0.27684301363812382768004599768562D0)
  88.       PARAMETER (P2D7=0.20346456801027136079140447593585D0)
  89.       PARAMETER (X3D7=0.58359043236891682005669766866292D0)
  90.       PARAMETER (P3D7=0.12984754760823244082645620288963D0)
  91.       PARAMETER (X4D7=0.86024013565621944784791291887512D0)
  92.       PARAMETER (P4D7=0.31180970950008082173875147096569D-1)
  93. *
  94. *  Générateurs pour la méthode de Gauss-Jacobi de degré 9 : GJ10-9-5 :
  95. *
  96.       REAL*8 X1D9,P1D9,X2D9,P2D9,X3D9,P3D9,X4D9,P4D9,X5D9,P5D9
  97.       PARAMETER (X1D9=0.39809857051468742340806690093331D-1)
  98.       PARAMETER (P1D9=0.96781590226651679274360971636169D-1)
  99.       PARAMETER (X2D9=0.19801341787360817253579213679530D0)
  100.       PARAMETER (P2D9=0.16717463809436956549167562309770D0)
  101.       PARAMETER (X3D9=0.43797481024738614400501252000523D0)
  102.       PARAMETER (P3D9=0.14638698708466980869803786935596D0)
  103.       PARAMETER (X4D9=0.69546427335363609451461482372117D0)
  104.       PARAMETER (P4D9=0.73908870072616670350633219341705D-1)
  105.       PARAMETER (X5D9=0.90146491420117357387650110211225D0)
  106.       PARAMETER (P5D9=0.15747914521692276185292316568490D-1)
  107. *
  108. *  Générateurs pour la méthode de Gauss-Jacobi de degré 11 : GJ10-11-6 :
  109. *
  110.       REAL*8 X1D11,P1D11,X2D11,P2D11,X3D11,P3D11
  111.       REAL*8 X4D11,P4D11,X5D11,P5D11,X6D11,P6D11
  112.       PARAMETER (X1D11=0.29316427159784891972050276913165D-1)
  113.       PARAMETER (P1D11=0.72310330725508683655454326124839D-1)
  114.       PARAMETER (X2D11=0.14807859966848429184997685249598D0)
  115.       PARAMETER (P2D11=0.13554249723151861684069039663804D0)
  116.       PARAMETER (X3D11=0.33698469028115429909705297208078D0)
  117.       PARAMETER (P3D11=0.14079255378819892811907683907092D0)
  118.       PARAMETER (X4D11=0.55867151877155013208139334180552D0)
  119.       PARAMETER (P4D11=0.98661150890655264120584510548346D-1)
  120.       PARAMETER (X5D11=0.76923386203005450091688336011564D0)
  121.       PARAMETER (P5D11=0.43955165550508975508176624305422D-1)
  122.       PARAMETER (X6D11=0.92694567131974111485187396581969D0)
  123.       PARAMETER (P6D11=0.87383018136095317560173033123964D-2)
  124. *
  125.       INTEGER NOPG
  126. *
  127. * Executable statements
  128. *
  129.       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingj10'
  130. *
  131. * Méthode de nom : GJ10-1-1
  132. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  133. *                  d'ordre 1 à 1 point
  134. *                  espace de référence de dimension 1
  135. *
  136. * In INIPG : SEGINI PGCOUR
  137.       CALL INIPG('GJ10-1-1','GAUSS-JACOBI10','SEGMENT',
  138.      $     1,1,1,
  139.      $     PGCOUR,
  140.      $     IMPR,IRET)
  141.       IF (IRET.NE.0) GOTO 9999
  142.       NOPG=0
  143.       XCOR(1)=X1D1
  144.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D1,IMPR,IRET)
  145.       IF (IRET.NE.0) GOTO 9999
  146.       SEGDES PGCOUR
  147.       MYPGS.LISPG(**)=PGCOUR
  148. *
  149. * Méthode de nom : GJ10-3-2
  150. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  151. *                  d'ordre 3 à 2 points
  152. *                  espace de référence de dimension 1
  153. *
  154. * In INIPG : SEGINI PGCOUR
  155.       CALL INIPG('GJ10-3-2','GAUSS-JACOBI10','SEGMENT',
  156.      $     3,2,1,
  157.      $     PGCOUR,
  158.      $     IMPR,IRET)
  159.       IF (IRET.NE.0) GOTO 9999
  160.       NOPG=0
  161.       XCOR(1)=X1D3
  162.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET)
  163.       IF (IRET.NE.0) GOTO 9999
  164.       XCOR(1)=X2D3
  165.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D3,IMPR,IRET)
  166.       IF (IRET.NE.0) GOTO 9999
  167.       SEGDES PGCOUR
  168.       MYPGS.LISPG(**)=PGCOUR
  169. *
  170. * Méthode de nom : GJ10-5-3
  171. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  172. *                  d'ordre 5 à 3 points
  173. *                  espace de référence de dimension 1
  174. *
  175. * In INIPG : SEGINI PGCOUR
  176.       CALL INIPG('GJ10-5-3','GAUSS-JACOBI10','SEGMENT',
  177.      $     5,3,1,
  178.      $     PGCOUR,
  179.      $     IMPR,IRET)
  180.       IF (IRET.NE.0) GOTO 9999
  181.       NOPG=0
  182.       XCOR(1)=X1D5
  183.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D5,IMPR,IRET)
  184.       IF (IRET.NE.0) GOTO 9999
  185.       XCOR(1)=X2D5
  186.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D5,IMPR,IRET)
  187.       IF (IRET.NE.0) GOTO 9999
  188.       XCOR(1)=X3D5
  189.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D5,IMPR,IRET)
  190.       IF (IRET.NE.0) GOTO 9999
  191.       SEGDES PGCOUR
  192.       MYPGS.LISPG(**)=PGCOUR
  193. *
  194. * Méthode de nom : GJ10-7-4
  195. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  196. *                  d'ordre 7 à 4 points
  197. *                  espace de référence de dimension 1
  198. *
  199. * In INIPG : SEGINI PGCOUR
  200.       CALL INIPG('GJ10-7-4','GAUSS-JACOBI10','SEGMENT',
  201.      $     7,4,1,
  202.      $     PGCOUR,
  203.      $     IMPR,IRET)
  204.       IF (IRET.NE.0) GOTO 9999
  205.       NOPG=0
  206.       XCOR(1)=X1D7
  207.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D7,IMPR,IRET)
  208.       IF (IRET.NE.0) GOTO 9999
  209.       XCOR(1)=X2D7
  210.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D7,IMPR,IRET)
  211.       IF (IRET.NE.0) GOTO 9999
  212.       XCOR(1)=X3D7
  213.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D7,IMPR,IRET)
  214.       IF (IRET.NE.0) GOTO 9999
  215.       XCOR(1)=X4D7
  216.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D7,IMPR,IRET)
  217.       IF (IRET.NE.0) GOTO 9999
  218.       SEGDES PGCOUR
  219.       MYPGS.LISPG(**)=PGCOUR
  220. *
  221. * Méthode de nom : GJ10-9-5
  222. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  223. *                  d'ordre 9 à 5 points
  224. *                  espace de référence de dimension 1
  225. *
  226. * In INIPG : SEGINI PGCOUR
  227.       CALL INIPG('GJ10-9-5','GAUSS-JACOBI10','SEGMENT',
  228.      $     9,5,1,
  229.      $     PGCOUR,
  230.      $     IMPR,IRET)
  231.       IF (IRET.NE.0) GOTO 9999
  232.       NOPG=0
  233.       XCOR(1)=X1D9
  234.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D9,IMPR,IRET)
  235.       IF (IRET.NE.0) GOTO 9999
  236.       XCOR(1)=X2D9
  237.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D9,IMPR,IRET)
  238.       IF (IRET.NE.0) GOTO 9999
  239.       XCOR(1)=X3D9
  240.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D9,IMPR,IRET)
  241.       IF (IRET.NE.0) GOTO 9999
  242.       XCOR(1)=X4D9
  243.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D9,IMPR,IRET)
  244.       IF (IRET.NE.0) GOTO 9999
  245.       XCOR(1)=X5D9
  246.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D9,IMPR,IRET)
  247.       IF (IRET.NE.0) GOTO 9999
  248.       SEGDES PGCOUR
  249.       MYPGS.LISPG(**)=PGCOUR
  250. *
  251. * Méthode de nom : GJ10-11-6
  252. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  253. *                  d'ordre 11 à 6 points
  254. *                  espace de référence de dimension 1
  255. *
  256. * In INIPG : SEGINI PGCOUR
  257.       CALL INIPG('GJ10-11-6','GAUSS-JACOBI10','SEGMENT',
  258.      $     11,6,1,
  259.      $     PGCOUR,
  260.      $     IMPR,IRET)
  261.       IF (IRET.NE.0) GOTO 9999
  262.       NOPG=0
  263.       XCOR(1)=X1D11
  264.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D11,IMPR,IRET)
  265.       IF (IRET.NE.0) GOTO 9999
  266.       XCOR(1)=X2D11
  267.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D11,IMPR,IRET)
  268.       IF (IRET.NE.0) GOTO 9999
  269.       XCOR(1)=X3D11
  270.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D11,IMPR,IRET)
  271.       IF (IRET.NE.0) GOTO 9999
  272.       XCOR(1)=X4D11
  273.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D11,IMPR,IRET)
  274.       IF (IRET.NE.0) GOTO 9999
  275.       XCOR(1)=X5D11
  276.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D11,IMPR,IRET)
  277.       IF (IRET.NE.0) GOTO 9999
  278.       XCOR(1)=X6D11
  279.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P6D11,IMPR,IRET)
  280.       IF (IRET.NE.0) GOTO 9999
  281.       SEGDES PGCOUR
  282.       MYPGS.LISPG(**)=PGCOUR
  283. *
  284. * Normal termination
  285. *
  286.       IRET=0
  287.       RETURN
  288. *
  289. * Format handling
  290. *
  291. *
  292. * Error handling
  293. *
  294.  9999 CONTINUE
  295.       IRET=1
  296.       WRITE(IOIMP,*) 'An error was detected in subroutine ingj10'
  297.       RETURN
  298. *
  299. * End of subroutine INGJ10
  300. *
  301.       END
  302.  
  303.  
  304.  
  305.  
  306.  

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