Télécharger ingapr.eso

Retour à la liste

Numérotation des lignes :

  1. C INGAPR SOURCE GOUNAND 05/12/21 21:31:54 5281
  2. SUBROUTINE INGAPR(MYPGS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INGAPR
  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 cubature
  10. C type Gauss pour le prisme à base triangulaire
  11. C (ordre 1 à 5).
  12. C
  13. C REFERENCES : cf. INGATR et INGASE car on utilise essentiellement
  14. C des méthodes produit des deux précédentes.
  15. C
  16. C LANGAGE : ESOPE
  17. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18. C mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES : INIPG, FIPG, PROPG
  21. C APPELE PAR : INPGS
  22. C***********************************************************************
  23. C ENTREES : -
  24. C ENTREES/SORTIES : MYPGS (actif en *MOD)
  25. C SORTIES : -
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION : v1, 11/05/00, version initiale
  29. C HISTORIQUE : v1, 11/05/00, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. -INC CCOPTIO
  38. CBEGININCLUDE SPOGAU
  39. SEGMENT POGAU
  40. CHARACTER*(LNNPG) NOMPG
  41. CHARACTER*(LNTPG) TYPMPG
  42. CHARACTER*(LNFPG) FORLPG
  43. INTEGER NORDPG
  44. REAL*8 XCOPG(NDLPG,NBPG)
  45. REAL*8 XPOPG(NBPG)
  46. ENDSEGMENT
  47. SEGMENT POGAUS
  48. POINTEUR LISPG(0).POGAU
  49. ENDSEGMENT
  50. CENDINCLUDE SPOGAU
  51. POINTEUR MYPGS.POGAUS
  52. POINTEUR PGCOUR.POGAU
  53. POINTEUR PGPRO1.POGAU
  54. POINTEUR PGPRO2.POGAU
  55. *
  56. INTEGER IMPR,IRET
  57. *
  58. *
  59. * Executable statements
  60. *
  61. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingapr'
  62. *
  63. * Méthode de nom : NCPR-1-6
  64. * Sur un prisme : cubature d'ordre 1 à 6 points
  65. * espace de référence de dimension 3
  66. *
  67. * In INIPG : SEGINI PGCOUR
  68. CALL INIPG('NCPR-1-6','NEWTON-COTES','PRISME',
  69. $ 1,6,3,
  70. $ PGCOUR,
  71. $ IMPR,IRET)
  72. IF (IRET.NE.0) GOTO 9999
  73. CALL FIPG('NCT2-1-3',MYPGS,PGPRO1,IMPR,IRET)
  74. IF (IRET.NE.0) GOTO 9999
  75. CALL FIPG('NCC1-1-2',MYPGS,PGPRO2,IMPR,IRET)
  76. IF (IRET.NE.0) GOTO 9999
  77. CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  78. IF (IRET.NE.0) GOTO 9999
  79. SEGDES PGCOUR
  80. MYPGS.LISPG(**)=PGCOUR
  81. *
  82. * Méthode de nom : NCPR-3-21
  83. * Sur un prisme : cubature d'ordre 3 à 21 points
  84. * espace de référence de dimension 3
  85. *
  86. * In INIPG : SEGINI PGCOUR
  87. CALL INIPG('NCPR-3-21','NEWTON-COTES','PRISME',
  88. $ 3,21,3,
  89. $ PGCOUR,
  90. $ IMPR,IRET)
  91. IF (IRET.NE.0) GOTO 9999
  92. CALL FIPG('NCT2-3-7',MYPGS,PGPRO1,IMPR,IRET)
  93. IF (IRET.NE.0) GOTO 9999
  94. CALL FIPG('NCC1-3-3',MYPGS,PGPRO2,IMPR,IRET)
  95. IF (IRET.NE.0) GOTO 9999
  96. CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. SEGDES PGCOUR
  99. MYPGS.LISPG(**)=PGCOUR
  100. *
  101. * Méthode de nom : GPPR-1-1
  102. * Sur un prisme : méthode gauss-produit d'ordre 1 à 1 point
  103. * espace de référence de dimension 3
  104. *
  105. * In INIPG : SEGINI PGCOUR
  106. CALL INIPG('GPPR-1-1','GAUSS-PRODUIT','PRISME',
  107. $ 1,1,3,
  108. $ PGCOUR,
  109. $ IMPR,IRET)
  110. IF (IRET.NE.0) GOTO 9999
  111. CALL FIPG('GAT2-1-1',MYPGS,PGPRO1,IMPR,IRET)
  112. IF (IRET.NE.0) GOTO 9999
  113. CALL FIPG('GAC1-1-1',MYPGS,PGPRO2,IMPR,IRET)
  114. IF (IRET.NE.0) GOTO 9999
  115. CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  116. IF (IRET.NE.0) GOTO 9999
  117. SEGDES PGCOUR
  118. MYPGS.LISPG(**)=PGCOUR
  119. *
  120. * Méthode de nom : GPPR-2-6
  121. * Sur un prisme : méthode gauss-produit d'ordre 2 à 6 points
  122. * espace de référence de dimension 3
  123. *
  124. * In INIPG : SEGINI PGCOUR
  125. CALL INIPG('GPPR-2-6','GAUSS-PRODUIT','PRISME',
  126. $ 2,6,3,
  127. $ PGCOUR,
  128. $ IMPR,IRET)
  129. IF (IRET.NE.0) GOTO 9999
  130. CALL FIPG('GAT2-2-3A',MYPGS,PGPRO1,IMPR,IRET)
  131. IF (IRET.NE.0) GOTO 9999
  132. CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET)
  133. IF (IRET.NE.0) GOTO 9999
  134. CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  135. IF (IRET.NE.0) GOTO 9999
  136. SEGDES PGCOUR
  137. MYPGS.LISPG(**)=PGCOUR
  138. *
  139. * Méthode de nom : GPPR-3-8
  140. * Sur un prisme : méthode gauss-produit d'ordre 3 à 8 points
  141. * espace de référence de dimension 3
  142. *
  143. * In INIPG : SEGINI PGCOUR
  144. CALL INIPG('GPPR-3-8','GAUSS-PRODUIT','PRISME',
  145. $ 3,8,3,
  146. $ PGCOUR,
  147. $ IMPR,IRET)
  148. IF (IRET.NE.0) GOTO 9999
  149. CALL FIPG('GPT2-3-4',MYPGS,PGPRO1,IMPR,IRET)
  150. IF (IRET.NE.0) GOTO 9999
  151. CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET)
  152. IF (IRET.NE.0) GOTO 9999
  153. CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  154. IF (IRET.NE.0) GOTO 9999
  155. SEGDES PGCOUR
  156. MYPGS.LISPG(**)=PGCOUR
  157. *
  158. * Méthode de nom : GPPR-4-18
  159. * Sur un prisme : méthode gauss-produit d'ordre 4 à 18 points
  160. * espace de référence de dimension 3
  161. *
  162. * In INIPG : SEGINI PGCOUR
  163. CALL INIPG('GPPR-4-18','GAUSS-PRODUIT','PRISME',
  164. $ 4,18,3,
  165. $ PGCOUR,
  166. $ IMPR,IRET)
  167. IF (IRET.NE.0) GOTO 9999
  168. CALL FIPG('GAT2-4-6A',MYPGS,PGPRO1,IMPR,IRET)
  169. IF (IRET.NE.0) GOTO 9999
  170. CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET)
  171. IF (IRET.NE.0) GOTO 9999
  172. CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  173. IF (IRET.NE.0) GOTO 9999
  174. SEGDES PGCOUR
  175. MYPGS.LISPG(**)=PGCOUR
  176. *
  177. * Méthode de nom : GPPR-5-21
  178. * Sur un prisme : méthode gauss-produit d'ordre 5 à 21 points
  179. * espace de référence de dimension 3
  180. *
  181. * In INIPG : SEGINI PGCOUR
  182. CALL INIPG('GPPR-5-21','GAUSS-PRODUIT','PRISME',
  183. $ 5,21,3,
  184. $ PGCOUR,
  185. $ IMPR,IRET)
  186. IF (IRET.NE.0) GOTO 9999
  187. CALL FIPG('GAT2-5-7',MYPGS,PGPRO1,IMPR,IRET)
  188. IF (IRET.NE.0) GOTO 9999
  189. CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET)
  190. IF (IRET.NE.0) GOTO 9999
  191. CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  192. IF (IRET.NE.0) GOTO 9999
  193. SEGDES PGCOUR
  194. MYPGS.LISPG(**)=PGCOUR
  195. *
  196. * Méthode de nom : GPPR-7-48
  197. * Sur un prisme : méthode gauss-produit d'ordre 7 à 48 points
  198. * espace de référence de dimension 3
  199. *
  200. * In INIPG : SEGINI PGCOUR
  201. CALL INIPG('GPPR-7-48','GAUSS-PRODUIT','PRISME',
  202. $ 7,48,3,
  203. $ PGCOUR,
  204. $ IMPR,IRET)
  205. IF (IRET.NE.0) GOTO 9999
  206. CALL FIPG('GAT2-7-12',MYPGS,PGPRO1,IMPR,IRET)
  207. IF (IRET.NE.0) GOTO 9999
  208. CALL FIPG('GAC1-7-4',MYPGS,PGPRO2,IMPR,IRET)
  209. IF (IRET.NE.0) GOTO 9999
  210. CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  211. IF (IRET.NE.0) GOTO 9999
  212. SEGDES PGCOUR
  213. MYPGS.LISPG(**)=PGCOUR
  214. *
  215. * Normal termination
  216. *
  217. IRET=0
  218. RETURN
  219. *
  220. * Format handling
  221. *
  222. *
  223. * Error handling
  224. *
  225. 9999 CONTINUE
  226. IRET=1
  227. WRITE(IOIMP,*) 'An error was detected in subroutine ingapr'
  228. RETURN
  229. *
  230. * End of subroutine INGAPR
  231. *
  232. END
  233.  
  234.  
  235.  
  236.  

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