Télécharger ingj10.eso

Retour à la liste

Numérotation des lignes :

  1. C INGJ10 SOURCE GOUNAND 05/12/21 21:32:32 5281
  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. -INC CCOPTIO
  45. CBEGININCLUDE SPOGAU
  46. SEGMENT POGAU
  47. CHARACTER*(LNNPG) NOMPG
  48. CHARACTER*(LNTPG) TYPMPG
  49. CHARACTER*(LNFPG) FORLPG
  50. INTEGER NORDPG
  51. REAL*8 XCOPG(NDLPG,NBPG)
  52. REAL*8 XPOPG(NBPG)
  53. ENDSEGMENT
  54. SEGMENT POGAUS
  55. POINTEUR LISPG(0).POGAU
  56. ENDSEGMENT
  57. CENDINCLUDE SPOGAU
  58. POINTEUR MYPGS.POGAUS
  59. POINTEUR PGCOUR.POGAU
  60. *
  61. INTEGER IMPR,IRET
  62. *
  63. INTEGER DIMSRF
  64. PARAMETER(DIMSRF=1)
  65. REAL*8 XCOR(DIMSRF)
  66. *
  67. * Générateurs pour la méthode de Gauss-Jacobi de degré 1 : GJ10-1-1 :
  68. *
  69. REAL*8 X1D1,P1D1
  70. PARAMETER (X1D1=1.D0/3.D0)
  71. PARAMETER (P1D1=0.5D0)
  72. *
  73. * Générateurs pour la méthode de Gauss-Jacobi de degré 3 : GJ10-3-2 :
  74. *
  75. REAL*8 X1D3,P1D3,X2D3,P2D3
  76. PARAMETER (X1D3=0.15505102572168219018027159252941D0)
  77. PARAMETER (P1D3=0.31804138174397716939436900207515D0)
  78. PARAMETER (X2D3=0.64494897427831780981972840747060D0)
  79. PARAMETER (P2D3=0.18195861825602283060563099792484D0)
  80. *
  81. * Générateurs pour la méthode de Gauss-Jacobi de degré 5 : GJ10-5-3 :
  82. *
  83. REAL*8 X1D5,P1D5,X2D5,P2D5,X3D5,P3D5
  84. PARAMETER (X1D5=0.88587959512703947395546143769455D-1)
  85. PARAMETER (P1D5=0.20093191373895963077219813326462D0)
  86. PARAMETER (X2D5=0.40946686444073471086492625206883D0)
  87. PARAMETER (P2D5=0.22924110635958624669392059455632D0)
  88. PARAMETER (X3D5=0.78765946176084705602524188987600D0)
  89. PARAMETER (P3D5=0.69826979901454122533881272179078D-1)
  90. *
  91. * Générateurs pour la méthode de Gauss-Jacobi de degré 7 : GJ10-7-4 :
  92. *
  93. REAL*8 X1D7,P1D7,X2D7,P2D7,X3D7,P3D7,X4D7,P4D7
  94. PARAMETER (X1D7=0.57104196114517682193121192554116D-1)
  95. PARAMETER (P1D7=0.13550691343148811620826417407793D0)
  96. PARAMETER (X2D7=0.27684301363812382768004599768562D0)
  97. PARAMETER (P2D7=0.20346456801027136079140447593585D0)
  98. PARAMETER (X3D7=0.58359043236891682005669766866292D0)
  99. PARAMETER (P3D7=0.12984754760823244082645620288963D0)
  100. PARAMETER (X4D7=0.86024013565621944784791291887512D0)
  101. PARAMETER (P4D7=0.31180970950008082173875147096569D-1)
  102. *
  103. * Générateurs pour la méthode de Gauss-Jacobi de degré 9 : GJ10-9-5 :
  104. *
  105. REAL*8 X1D9,P1D9,X2D9,P2D9,X3D9,P3D9,X4D9,P4D9,X5D9,P5D9
  106. PARAMETER (X1D9=0.39809857051468742340806690093331D-1)
  107. PARAMETER (P1D9=0.96781590226651679274360971636169D-1)
  108. PARAMETER (X2D9=0.19801341787360817253579213679530D0)
  109. PARAMETER (P2D9=0.16717463809436956549167562309770D0)
  110. PARAMETER (X3D9=0.43797481024738614400501252000523D0)
  111. PARAMETER (P3D9=0.14638698708466980869803786935596D0)
  112. PARAMETER (X4D9=0.69546427335363609451461482372117D0)
  113. PARAMETER (P4D9=0.73908870072616670350633219341705D-1)
  114. PARAMETER (X5D9=0.90146491420117357387650110211225D0)
  115. PARAMETER (P5D9=0.15747914521692276185292316568490D-1)
  116. *
  117. * Générateurs pour la méthode de Gauss-Jacobi de degré 11 : GJ10-11-6 :
  118. *
  119. REAL*8 X1D11,P1D11,X2D11,P2D11,X3D11,P3D11
  120. REAL*8 X4D11,P4D11,X5D11,P5D11,X6D11,P6D11
  121. PARAMETER (X1D11=0.29316427159784891972050276913165D-1)
  122. PARAMETER (P1D11=0.72310330725508683655454326124839D-1)
  123. PARAMETER (X2D11=0.14807859966848429184997685249598D0)
  124. PARAMETER (P2D11=0.13554249723151861684069039663804D0)
  125. PARAMETER (X3D11=0.33698469028115429909705297208078D0)
  126. PARAMETER (P3D11=0.14079255378819892811907683907092D0)
  127. PARAMETER (X4D11=0.55867151877155013208139334180552D0)
  128. PARAMETER (P4D11=0.98661150890655264120584510548346D-1)
  129. PARAMETER (X5D11=0.76923386203005450091688336011564D0)
  130. PARAMETER (P5D11=0.43955165550508975508176624305422D-1)
  131. PARAMETER (X6D11=0.92694567131974111485187396581969D0)
  132. PARAMETER (P6D11=0.87383018136095317560173033123964D-2)
  133. *
  134. INTEGER NOPG
  135. *
  136. * Executable statements
  137. *
  138. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingj10'
  139. *
  140. * Méthode de nom : GJ10-1-1
  141. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  142. * d'ordre 1 à 1 point
  143. * espace de référence de dimension 1
  144. *
  145. * In INIPG : SEGINI PGCOUR
  146. CALL INIPG('GJ10-1-1','GAUSS-JACOBI10','SEGMENT',
  147. $ 1,1,1,
  148. $ PGCOUR,
  149. $ IMPR,IRET)
  150. IF (IRET.NE.0) GOTO 9999
  151. NOPG=0
  152. XCOR(1)=X1D1
  153. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D1,IMPR,IRET)
  154. IF (IRET.NE.0) GOTO 9999
  155. SEGDES PGCOUR
  156. MYPGS.LISPG(**)=PGCOUR
  157. *
  158. * Méthode de nom : GJ10-3-2
  159. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  160. * d'ordre 3 à 2 points
  161. * espace de référence de dimension 1
  162. *
  163. * In INIPG : SEGINI PGCOUR
  164. CALL INIPG('GJ10-3-2','GAUSS-JACOBI10','SEGMENT',
  165. $ 3,2,1,
  166. $ PGCOUR,
  167. $ IMPR,IRET)
  168. IF (IRET.NE.0) GOTO 9999
  169. NOPG=0
  170. XCOR(1)=X1D3
  171. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D3,IMPR,IRET)
  172. IF (IRET.NE.0) GOTO 9999
  173. XCOR(1)=X2D3
  174. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D3,IMPR,IRET)
  175. IF (IRET.NE.0) GOTO 9999
  176. SEGDES PGCOUR
  177. MYPGS.LISPG(**)=PGCOUR
  178. *
  179. * Méthode de nom : GJ10-5-3
  180. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  181. * d'ordre 5 à 3 points
  182. * espace de référence de dimension 1
  183. *
  184. * In INIPG : SEGINI PGCOUR
  185. CALL INIPG('GJ10-5-3','GAUSS-JACOBI10','SEGMENT',
  186. $ 5,3,1,
  187. $ PGCOUR,
  188. $ IMPR,IRET)
  189. IF (IRET.NE.0) GOTO 9999
  190. NOPG=0
  191. XCOR(1)=X1D5
  192. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D5,IMPR,IRET)
  193. IF (IRET.NE.0) GOTO 9999
  194. XCOR(1)=X2D5
  195. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D5,IMPR,IRET)
  196. IF (IRET.NE.0) GOTO 9999
  197. XCOR(1)=X3D5
  198. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D5,IMPR,IRET)
  199. IF (IRET.NE.0) GOTO 9999
  200. SEGDES PGCOUR
  201. MYPGS.LISPG(**)=PGCOUR
  202. *
  203. * Méthode de nom : GJ10-7-4
  204. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  205. * d'ordre 7 à 4 points
  206. * espace de référence de dimension 1
  207. *
  208. * In INIPG : SEGINI PGCOUR
  209. CALL INIPG('GJ10-7-4','GAUSS-JACOBI10','SEGMENT',
  210. $ 7,4,1,
  211. $ PGCOUR,
  212. $ IMPR,IRET)
  213. IF (IRET.NE.0) GOTO 9999
  214. NOPG=0
  215. XCOR(1)=X1D7
  216. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D7,IMPR,IRET)
  217. IF (IRET.NE.0) GOTO 9999
  218. XCOR(1)=X2D7
  219. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D7,IMPR,IRET)
  220. IF (IRET.NE.0) GOTO 9999
  221. XCOR(1)=X3D7
  222. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D7,IMPR,IRET)
  223. IF (IRET.NE.0) GOTO 9999
  224. XCOR(1)=X4D7
  225. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D7,IMPR,IRET)
  226. IF (IRET.NE.0) GOTO 9999
  227. SEGDES PGCOUR
  228. MYPGS.LISPG(**)=PGCOUR
  229. *
  230. * Méthode de nom : GJ10-9-5
  231. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  232. * d'ordre 9 à 5 points
  233. * espace de référence de dimension 1
  234. *
  235. * In INIPG : SEGINI PGCOUR
  236. CALL INIPG('GJ10-9-5','GAUSS-JACOBI10','SEGMENT',
  237. $ 9,5,1,
  238. $ PGCOUR,
  239. $ IMPR,IRET)
  240. IF (IRET.NE.0) GOTO 9999
  241. NOPG=0
  242. XCOR(1)=X1D9
  243. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D9,IMPR,IRET)
  244. IF (IRET.NE.0) GOTO 9999
  245. XCOR(1)=X2D9
  246. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D9,IMPR,IRET)
  247. IF (IRET.NE.0) GOTO 9999
  248. XCOR(1)=X3D9
  249. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D9,IMPR,IRET)
  250. IF (IRET.NE.0) GOTO 9999
  251. XCOR(1)=X4D9
  252. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D9,IMPR,IRET)
  253. IF (IRET.NE.0) GOTO 9999
  254. XCOR(1)=X5D9
  255. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D9,IMPR,IRET)
  256. IF (IRET.NE.0) GOTO 9999
  257. SEGDES PGCOUR
  258. MYPGS.LISPG(**)=PGCOUR
  259. *
  260. * Méthode de nom : GJ10-11-6
  261. * Sur un segment : méthode de Gauss-Jacobi \alpha=1 \beta=0
  262. * d'ordre 11 à 6 points
  263. * espace de référence de dimension 1
  264. *
  265. * In INIPG : SEGINI PGCOUR
  266. CALL INIPG('GJ10-11-6','GAUSS-JACOBI10','SEGMENT',
  267. $ 11,6,1,
  268. $ PGCOUR,
  269. $ IMPR,IRET)
  270. IF (IRET.NE.0) GOTO 9999
  271. NOPG=0
  272. XCOR(1)=X1D11
  273. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P1D11,IMPR,IRET)
  274. IF (IRET.NE.0) GOTO 9999
  275. XCOR(1)=X2D11
  276. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P2D11,IMPR,IRET)
  277. IF (IRET.NE.0) GOTO 9999
  278. XCOR(1)=X3D11
  279. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P3D11,IMPR,IRET)
  280. IF (IRET.NE.0) GOTO 9999
  281. XCOR(1)=X4D11
  282. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P4D11,IMPR,IRET)
  283. IF (IRET.NE.0) GOTO 9999
  284. XCOR(1)=X5D11
  285. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P5D11,IMPR,IRET)
  286. IF (IRET.NE.0) GOTO 9999
  287. XCOR(1)=X6D11
  288. CALL GCSINO(PGCOUR,NOPG,DIMSRF,XCOR,P6D11,IMPR,IRET)
  289. IF (IRET.NE.0) GOTO 9999
  290. SEGDES PGCOUR
  291. MYPGS.LISPG(**)=PGCOUR
  292. *
  293. * Normal termination
  294. *
  295. IRET=0
  296. RETURN
  297. *
  298. * Format handling
  299. *
  300. *
  301. * Error handling
  302. *
  303. 9999 CONTINUE
  304. IRET=1
  305. WRITE(IOIMP,*) 'An error was detected in subroutine ingj10'
  306. RETURN
  307. *
  308. * End of subroutine INGJ10
  309. *
  310. END
  311.  
  312.  
  313.  
  314.  

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