Télécharger la plaquette Cast3M


fr en

Télécharger ingase.eso

Retour à la liste

Numérotation des lignes : 

ingase

  1. C INGASE    SOURCE    GOUNAND   21/06/02    21:16:41     11022          
  2.       SUBROUTINE INGASE(MYPGS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INGASE
  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 Gauss
  10. C               à une dimension (ordre 1 à 11).
  11. C
  12. C REFERENCES  : Numerical recipes (sous-programme gauleg modifié)
  13. C               on a recalculé les poids et points de Gauss en REAL*16
  14. C               donc avec environ 32 (plutôt 31) chiffres significatifs
  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, GCCESY
  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, 19/10/99, version initiale
  28. C HISTORIQUE : v1, 19/10/99, 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 PPARAM
  37. -INC CCOPTIO
  38. -INC TNLIN      
  39. *-INC SPOGAU
  40.       POINTEUR MYPGS.POGAUS
  41.       POINTEUR PGCOUR.POGAU
  42. *
  43.       INTEGER IMPR,IRET
  44. *
  45.       INTEGER DIMSRF
  46.       PARAMETER(DIMSRF=1)
  47.       REAL*8 XCOR(DIMSRF)
  48.       REAL*8 POIDS
  49. *
  50. * Pour les méthodes sur un segment, tous les générateurs sont
  51. * à symétrie centrales
  52. *
  53. *  Générateurs pour la méthode de Gauss de degré 1 : GAC1-1-1 :
  54. *   - l'origine
  55.       REAL*8 X0D1,P0D1
  56.       PARAMETER (X0D1=0.D0)
  57.       PARAMETER (P0D1=2.D0)
  58. *
  59. *  Générateurs pour la méthode de Gauss de degré 3 : GAC1-3-2 :
  60. *   - le générateur symétrique (1./\sqrt{3.});(1.)
  61.       REAL*8 X1D3,P1D3
  62.       PARAMETER (X1D3=0.57735026918962576450914878050195D0)
  63.       PARAMETER (P1D3=1.D0)
  64. *
  65. *  Générateurs pour la méthode de Gauss de degré 5 : GAC1-5-3 :
  66. *   - l'origine
  67.       REAL*8 X0D5,P0D5
  68.       PARAMETER (X0D5=0.D0)
  69.       PARAMETER (P0D5=8.D0/9.D0)
  70. *   - le générateur symétrique (\sqrt{3./5.});(5./9.)
  71.       REAL*8 X1D5,P1D5
  72.       PARAMETER (X1D5=0.77459666924148337703585307995648D0)
  73.       PARAMETER (P1D5=5.D0/9.D0)
  74. *
  75. *  Générateurs pour la méthode de Gauss de degré 7 : GAC1-7-4 :
  76. *   - les générateurs symétriques :
  77. *     (\sqrt{\frac{3.-2\sqrt{6./5.}}{7.}});(1./2.+1./(6\sqrt{6./5.}))
  78. *     (\sqrt{\frac{3.+2\sqrt{6./5.}}{7.}});(1./2.-1./(6\sqrt{6./5.}))
  79.       REAL*8 X1D7,P1D7,X2D7,P2D7
  80.       PARAMETER (X1D7=0.33998104358485626480266575910324D0)
  81.       PARAMETER (P1D7=0.65214515486254614262693605077800D0)
  82.       PARAMETER (X2D7=0.86113631159405257522394648889281D0)
  83.       PARAMETER (P2D7=0.34785484513745385737306394922200D0)
  84. *
  85. *  Générateurs pour la méthode de Gauss de degré 9 : GAC1-9-5 :
  86. *   - l'origine
  87.       REAL*8 X0D9,P0D9
  88.       PARAMETER (X0D9=0.D0)
  89.       PARAMETER (P0D9=128.D0/225.D0)
  90. *   - les générateurs symétriques
  91. *     ((1./3.)\sqrt{5.-4.\sqrt{5./14.}});(161./450.+13./(180.\sqrt{5./14.}))
  92. *     ((1./3.)\sqrt{5.+4.\sqrt{5./14.}});(161./450.-13./(180.\sqrt{5./14.}))
  93.       REAL*8 X1D9,P1D9,X2D9,P2D9
  94.       PARAMETER (X1D9=0.53846931010568309103631442070021D0)
  95.       PARAMETER (P1D9=0.47862867049936646804129151483564D0)
  96.       PARAMETER (X2D9=0.90617984593866399279762687829939D0)
  97.       PARAMETER (P2D9=0.23692688505618908751426404071992D0)
  98. *
  99. *  Générateurs pour la méthode de Gauss de degré 11 : GAC1-11-6 :
  100. *   - les générateurs symétriques :
  101.       REAL*8 X1D11,P1D11,X2D11,P2D11,X3D11,P3D11
  102.       PARAMETER (X1D11=0.23861918608319690863050172168071D0)
  103.       PARAMETER (P1D11=0.46791393457269104738987034398956D0)
  104.       PARAMETER (X2D11=0.66120938646626451366139959501990D0)
  105.       PARAMETER (P2D11=0.36076157304813860756983351383773D0)
  106.       PARAMETER (X3D11=0.93246951420315202781230155449399D0)
  107.       PARAMETER (P3D11=0.17132449237917034504029614217274D0)
  108. *
  109.       INTEGER NOPG
  110. *
  111. * Executable statements
  112. *
  113.       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingase'
  114. *
  115. * Méthode de nom : NCC1-1-2
  116. * Sur un segment : Cubature d'ordre 1 à 2 points
  117. *                  espace de référence de dimension 1
  118. *
  119. * In INIPG : SEGINI PGCOUR
  120.       CALL INIPG('NCC1-1-2','NEWTON-COTES','SEGMENT',
  121.      $     1,2,1,
  122.      $     PGCOUR,
  123.      $     IMPR,IRET)
  124.       IF (IRET.NE.0) GOTO 9999
  125.       NOPG=0
  126.       XCOR(1)=-1.D0
  127.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET)
  128.       XCOR(1)=1.D0
  129.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET)
  130.       IF (IRET.NE.0) GOTO 9999
  131.       SEGDES PGCOUR
  132.       MYPGS.LISPG(**)=PGCOUR
  133. *
  134. * Méthode de nom : NCC1-3-3
  135. * Sur un segment : Cubature d'ordre 3 à 3 points
  136. *                  espace de référence de dimension 1
  137. *
  138. * In INIPG : SEGINI PGCOUR
  139.       CALL INIPG('NCC1-3-3','NEWTON-COTES','SEGMENT',
  140.      $     3,3,1,
  141.      $     PGCOUR,
  142.      $     IMPR,IRET)
  143.       IF (IRET.NE.0) GOTO 9999
  144.       NOPG=0
  145.       XCOR(1)=0.D0
  146.       POIDS=4.D0/3.D0
  147.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,POIDS,IMPR,IRET)
  148.       XCOR(1)=1.D0
  149.       POIDS=1.D0/3.D0
  150.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,POIDS,IMPR,IRET)
  151.       IF (IRET.NE.0) GOTO 9999
  152.       SEGDES PGCOUR
  153.       MYPGS.LISPG(**)=PGCOUR
  154. *
  155. * Méthode de nom : GAC1-1-1
  156. * Sur un segment : méthode de Gauss d'ordre 1 à 1 point
  157. *                  espace de référence de dimension 1
  158. *
  159. * In INIPG : SEGINI PGCOUR
  160.       CALL INIPG('GAC1-1-1','GAUSS','SEGMENT',
  161.      $     1,1,1,
  162.      $     PGCOUR,
  163.      $     IMPR,IRET)
  164.       IF (IRET.NE.0) GOTO 9999
  165.       NOPG=0
  166.       XCOR(1)=X0D1
  167.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P0D1,IMPR,IRET)
  168.       IF (IRET.NE.0) GOTO 9999
  169.       SEGDES PGCOUR
  170.       MYPGS.LISPG(**)=PGCOUR
  171. *
  172. * Méthode de nom : GAC1-3-2
  173. * Sur un segment : méthode de Gauss d'ordre 3 à 2 points
  174. *                  espace de référence de dimension 1
  175. *
  176. * In INIPG : SEGINI PGCOUR
  177.       CALL INIPG('GAC1-3-2','GAUSS','SEGMENT',
  178.      $     3,2,1,
  179.      $     PGCOUR,
  180.      $     IMPR,IRET)
  181.       IF (IRET.NE.0) GOTO 9999
  182.       NOPG=0
  183.       XCOR(1)=X1D3
  184.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET)
  185.       IF (IRET.NE.0) GOTO 9999
  186.       SEGDES PGCOUR
  187.       MYPGS.LISPG(**)=PGCOUR
  188. *
  189. * Méthode de nom : GAC1-5-3
  190. * Sur un segment : méthode de Gauss d'ordre 5 à 3 points
  191. *                  espace de référence de dimension 1
  192. *
  193. * In INIPG : SEGINI PGCOUR
  194.       CALL INIPG('GAC1-5-3','GAUSS','SEGMENT',
  195.      $     5,3,1,
  196.      $     PGCOUR,
  197.      $     IMPR,IRET)
  198.       IF (IRET.NE.0) GOTO 9999
  199.       NOPG=0
  200.       XCOR(1)=X0D5
  201.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P0D5,IMPR,IRET)
  202.       IF (IRET.NE.0) GOTO 9999
  203.       XCOR(1)=X1D5
  204.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P1D5,IMPR,IRET)
  205.       IF (IRET.NE.0) GOTO 9999
  206.       SEGDES PGCOUR
  207.       MYPGS.LISPG(**)=PGCOUR
  208. *
  209. * Méthode de nom : GAC1-7-4
  210. * Sur un segment : méthode de Gauss d'ordre 7 à 4 points
  211. *                  espace de référence de dimension 1
  212. *
  213. * In INIPG : SEGINI PGCOUR
  214.       CALL INIPG('GAC1-7-4','GAUSS','SEGMENT',
  215.      $     7,4,1,
  216.      $     PGCOUR,
  217.      $     IMPR,IRET)
  218.       IF (IRET.NE.0) GOTO 9999
  219.       NOPG=0
  220.       XCOR(1)=X1D7
  221.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P1D7,IMPR,IRET)
  222.       IF (IRET.NE.0) GOTO 9999
  223.       XCOR(1)=X2D7
  224.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P2D7,IMPR,IRET)
  225.       IF (IRET.NE.0) GOTO 9999
  226.       SEGDES PGCOUR
  227.       MYPGS.LISPG(**)=PGCOUR
  228. *
  229. * Méthode de nom : GAC1-9-5
  230. * Sur un segment : méthode de Gauss d'ordre 9 à 5 points
  231. *                  espace de référence de dimension 1
  232. *
  233. * In INIPG : SEGINI PGCOUR
  234.       CALL INIPG('GAC1-9-5','GAUSS','SEGMENT',
  235.      $     9,5,1,
  236.      $     PGCOUR,
  237.      $     IMPR,IRET)
  238.       IF (IRET.NE.0) GOTO 9999
  239.       NOPG=0
  240.       XCOR(1)=X0D9
  241.       CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P0D9,IMPR,IRET)
  242.       IF (IRET.NE.0) GOTO 9999
  243.       XCOR(1)=X1D9
  244.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P1D9,IMPR,IRET)
  245.       IF (IRET.NE.0) GOTO 9999
  246.       XCOR(1)=X2D9
  247.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P2D9,IMPR,IRET)
  248.       IF (IRET.NE.0) GOTO 9999
  249.       SEGDES PGCOUR
  250.       MYPGS.LISPG(**)=PGCOUR
  251. *
  252. * Méthode de nom : GAC1-11-6
  253. * Sur un segment : méthode de Gauss d'ordre 11 à 6 points
  254. *                  espace de référence de dimension 1
  255. *
  256. * In INIPG : SEGINI PGCOUR
  257.       CALL INIPG('GAC1-11-6','GAUSS','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 GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P1D11,IMPR,IRET)
  265.       IF (IRET.NE.0) GOTO 9999
  266.       XCOR(1)=X2D11
  267.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P2D11,IMPR,IRET)
  268.       IF (IRET.NE.0) GOTO 9999
  269.       XCOR(1)=X3D11
  270.       CALL GCCESY(PGCOUR,NOPG,DIMSRF,XCOR,P3D11,IMPR,IRET)
  271.       IF (IRET.NE.0) GOTO 9999
  272.       SEGDES PGCOUR
  273.       MYPGS.LISPG(**)=PGCOUR
  274. *
  275. * Normal termination
  276. *
  277.       IRET=0
  278.       RETURN
  279. *
  280. * Format handling
  281. *
  282. *
  283. * Error handling
  284. *
  285.  9999 CONTINUE
  286.       IRET=1
  287.       WRITE(IOIMP,*) 'An error was detected in subroutine ingase'
  288.       RETURN
  289. *
  290. * End of subroutine INGASE
  291. *
  292.       END
  293.  
  294.  
  295.  
  296.  
  297.  

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