Télécharger ingj20.eso

Retour à la liste

Numérotation des lignes :

  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
  147. CALL INIPG('GJ20-1-1','GAUSS-JACOBI20','SEGMENT',
  148. $ 1,1,1,
  149. $ PGCOUR,
  150. $ IMPR,IRET)
  151. IF (IRET.NE.0) GOTO 9999
  152. NOPG=0
  153. XCOR(1)=X1D1
  154. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D1,IMPR,IRET)
  155. IF (IRET.NE.0) GOTO 9999
  156. SEGDES PGCOUR
  157. MYPGS.LISPG(**)=PGCOUR
  158. *
  159. * Méthode de nom : GJ20-3-2
  160. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  161. * d'ordre 3 à 2 points
  162. * espace de référence de dimension 1
  163. *
  164. * In INIPG : SEGINI PGCOUR
  165. CALL INIPG('GJ20-3-2','GAUSS-JACOBI20','SEGMENT',
  166. $ 3,2,1,
  167. $ PGCOUR,
  168. $ IMPR,IRET)
  169. IF (IRET.NE.0) GOTO 9999
  170. NOPG=0
  171. XCOR(1)=X1D3
  172. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET)
  173. IF (IRET.NE.0) GOTO 9999
  174. XCOR(1)=X2D3
  175. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D3,IMPR,IRET)
  176. IF (IRET.NE.0) GOTO 9999
  177. SEGDES PGCOUR
  178. MYPGS.LISPG(**)=PGCOUR
  179. *
  180. * Méthode de nom : GJ20-5-3
  181. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  182. * d'ordre 5 à 3 points
  183. * espace de référence de dimension 1
  184. *
  185. * In INIPG : SEGINI PGCOUR
  186. CALL INIPG('GJ20-5-3','GAUSS-JACOBI20','SEGMENT',
  187. $ 5,3,1,
  188. $ PGCOUR,
  189. $ IMPR,IRET)
  190. IF (IRET.NE.0) GOTO 9999
  191. NOPG=0
  192. XCOR(1)=X1D5
  193. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D5,IMPR,IRET)
  194. IF (IRET.NE.0) GOTO 9999
  195. XCOR(1)=X2D5
  196. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D5,IMPR,IRET)
  197. IF (IRET.NE.0) GOTO 9999
  198. XCOR(1)=X3D5
  199. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D5,IMPR,IRET)
  200. IF (IRET.NE.0) GOTO 9999
  201. SEGDES PGCOUR
  202. MYPGS.LISPG(**)=PGCOUR
  203. *
  204. * Méthode de nom : GJ20-7-4
  205. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  206. * d'ordre 7 à 4 points
  207. * espace de référence de dimension 1
  208. *
  209. * In INIPG : SEGINI PGCOUR
  210. CALL INIPG('GJ20-7-4','GAUSS-JACOBI20','SEGMENT',
  211. $ 7,4,1,
  212. $ PGCOUR,
  213. $ IMPR,IRET)
  214. IF (IRET.NE.0) GOTO 9999
  215. NOPG=0
  216. XCOR(1)=X1D7
  217. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D7,IMPR,IRET)
  218. IF (IRET.NE.0) GOTO 9999
  219. XCOR(1)=X2D7
  220. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D7,IMPR,IRET)
  221. IF (IRET.NE.0) GOTO 9999
  222. XCOR(1)=X3D7
  223. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D7,IMPR,IRET)
  224. IF (IRET.NE.0) GOTO 9999
  225. XCOR(1)=X4D7
  226. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D7,IMPR,IRET)
  227. IF (IRET.NE.0) GOTO 9999
  228. SEGDES PGCOUR
  229. MYPGS.LISPG(**)=PGCOUR
  230. *
  231. * Méthode de nom : GJ20-9-5
  232. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  233. * d'ordre 9 à 5 points
  234. * espace de référence de dimension 1
  235. *
  236. * In INIPG : SEGINI PGCOUR
  237. CALL INIPG('GJ20-9-5','GAUSS-JACOBI20','SEGMENT',
  238. $ 9,5,1,
  239. $ PGCOUR,
  240. $ IMPR,IRET)
  241. IF (IRET.NE.0) GOTO 9999
  242. NOPG=0
  243. XCOR(1)=X1D9
  244. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D9,IMPR,IRET)
  245. IF (IRET.NE.0) GOTO 9999
  246. XCOR(1)=X2D9
  247. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D9,IMPR,IRET)
  248. IF (IRET.NE.0) GOTO 9999
  249. XCOR(1)=X3D9
  250. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D9,IMPR,IRET)
  251. IF (IRET.NE.0) GOTO 9999
  252. XCOR(1)=X4D9
  253. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D9,IMPR,IRET)
  254. IF (IRET.NE.0) GOTO 9999
  255. XCOR(1)=X5D9
  256. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D9,IMPR,IRET)
  257. IF (IRET.NE.0) GOTO 9999
  258. SEGDES PGCOUR
  259. MYPGS.LISPG(**)=PGCOUR
  260. *
  261. * Méthode de nom : GJ20-11-6
  262. * Sur un segment : méthode de Gauss-Jacobi \alpha=2 \beta=0
  263. * d'ordre 11 à 6 points
  264. * espace de référence de dimension 1
  265. *
  266. * In INIPG : SEGINI PGCOUR
  267. CALL INIPG('GJ20-11-6','GAUSS-JACOBI20','SEGMENT',
  268. $ 11,6,1,
  269. $ PGCOUR,
  270. $ IMPR,IRET)
  271. IF (IRET.NE.0) GOTO 9999
  272. NOPG=0
  273. XCOR(1)=X1D11
  274. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D11,IMPR,IRET)
  275. IF (IRET.NE.0) GOTO 9999
  276. XCOR(1)=X2D11
  277. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D11,IMPR,IRET)
  278. IF (IRET.NE.0) GOTO 9999
  279. XCOR(1)=X3D11
  280. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D11,IMPR,IRET)
  281. IF (IRET.NE.0) GOTO 9999
  282. XCOR(1)=X4D11
  283. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D11,IMPR,IRET)
  284. IF (IRET.NE.0) GOTO 9999
  285. XCOR(1)=X5D11
  286. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D11,IMPR,IRET)
  287. IF (IRET.NE.0) GOTO 9999
  288. XCOR(1)=X6D11
  289. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P6D11,IMPR,IRET)
  290. IF (IRET.NE.0) GOTO 9999
  291. SEGDES PGCOUR
  292. MYPGS.LISPG(**)=PGCOUR
  293. *
  294. * Normal termination
  295. *
  296. IRET=0
  297. RETURN
  298. *
  299. * Format handling
  300. *
  301. *
  302. * Error handling
  303. *
  304. 9999 CONTINUE
  305. IRET=1
  306. WRITE(IOIMP,*) 'An error was detected in subroutine ingj20'
  307. RETURN
  308. *
  309. * End of subroutine INGJ20
  310. *
  311. END
  312.  
  313.  
  314.  
  315.  

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