Télécharger ingapy.eso

Retour à la liste

Numérotation des lignes :

  1. C INGAPY SOURCE GOUNAND 05/12/21 21:32:01 5281
  2. SUBROUTINE INGAPY(MYPGS,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : INGAPY
  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 la pyramide.
  11. C
  12. C REFERENCES : Castem donred.eso
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES : INIPG, GTSINO, GTRO3I, GT3FS9, GT3F10,
  18. C FIPG, CPROPG
  19. C APPELE PAR : INPGS
  20. C***********************************************************************
  21. C ENTREES : -
  22. C ENTREES/SORTIES : MYPGS (actif en *MOD)
  23. C SORTIES : -
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 22/10/99, version initiale
  27. C HISTORIQUE : v1, 22/10/99, création
  28. C HISTORIQUE : 29/5/00 rajout ordre 6
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35. -INC CCOPTIO
  36. CBEGININCLUDE SPOGAU
  37. SEGMENT POGAU
  38. CHARACTER*(LNNPG) NOMPG
  39. CHARACTER*(LNTPG) TYPMPG
  40. CHARACTER*(LNFPG) FORLPG
  41. INTEGER NORDPG
  42. REAL*8 XCOPG(NDLPG,NBPG)
  43. REAL*8 XPOPG(NBPG)
  44. ENDSEGMENT
  45. SEGMENT POGAUS
  46. POINTEUR LISPG(0).POGAU
  47. ENDSEGMENT
  48. CENDINCLUDE SPOGAU
  49. POINTEUR MYPGS.POGAUS
  50. POINTEUR PGCOUR.POGAU
  51. *
  52. INTEGER IMPR,IRET
  53. REAL*8 ZERO,UN,DEUTIE
  54. PARAMETER (ZERO=0.D0)
  55. PARAMETER (UN=1.D0)
  56. PARAMETER (DEUTIE=2.D0/3.D0)
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingapy'
  61. *
  62. * Méthode de nom : NCPY-1-5
  63. * Sur un tétraèdre : cubature d'ordre 0 à 5 points
  64. * espace de référence de dimension 3
  65. *
  66. * In INIPG : SEGINI PGCOUR
  67. CALL INIPG('NCPY-0-5','NEWTON-COTES','PYRAMIDE',
  68. $ 0,5,3,
  69. $ PGCOUR,
  70. $ IMPR,IRET)
  71. IF (IRET.NE.0) GOTO 9999
  72. PGCOUR.XCOPG(1,1)=UN
  73. PGCOUR.XCOPG(2,1)=ZERO
  74. PGCOUR.XCOPG(1,2)=ZERO
  75. PGCOUR.XCOPG(2,2)=UN
  76. PGCOUR.XCOPG(1,3)=-UN
  77. PGCOUR.XCOPG(2,3)=ZERO
  78. PGCOUR.XCOPG(1,4)=ZERO
  79. PGCOUR.XCOPG(2,4)=-UN
  80. DO I=1,4
  81. PGCOUR.XCOPG(3,I)=ZERO
  82. ENDDO
  83. PGCOUR.XCOPG(1,5)=ZERO
  84. PGCOUR.XCOPG(2,5)=ZERO
  85. PGCOUR.XCOPG(3,5)=UN
  86. DO I=1,5
  87. PGCOUR.XPOPG(I)=DEUTIE/5.D0
  88. ENDDO
  89. SEGDES PGCOUR
  90. MYPGS.LISPG(**)=PGCOUR
  91. *
  92. * Méthode de nom : GAPY-1-1
  93. * Sur un tétraèdre : cubature d'ordre 1 à 1 point
  94. * espace de référence de dimension 3
  95. *
  96. * In INIPG : SEGINI PGCOUR
  97. CALL INIPG('GAPY-1-1','GAUSS','PYRAMIDE',
  98. $ 1,1,3,
  99. $ PGCOUR,
  100. $ IMPR,IRET)
  101. IF (IRET.NE.0) GOTO 9999
  102. NBG=1
  103. IELE=25
  104. * In SMI2PG : SEGDES PGCOUR
  105. CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
  106. IF (IRET.NE.0) GOTO 9999
  107. MYPGS.LISPG(**)=PGCOUR
  108. *
  109. * Méthode de nom : GAPY-2-5
  110. * Sur un tétraèdre : cubature d'ordre 2 à 5 points
  111. * espace de référence de dimension 3
  112. *
  113. * In INIPG : SEGINI PGCOUR
  114. CALL INIPG('GAPY-2-5','GAUSS','PYRAMIDE',
  115. $ 2,5,3,
  116. $ PGCOUR,
  117. $ IMPR,IRET)
  118. IF (IRET.NE.0) GOTO 9999
  119. NBG=5
  120. IELE=25
  121. * In SMI2PG : SEGDES PGCOUR
  122. CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
  123. IF (IRET.NE.0) GOTO 9999
  124. MYPGS.LISPG(**)=PGCOUR
  125. *
  126. * Méthode de nom : GAPY-5-27
  127. * Sur un tétraèdre : cubature d'ordre 5 à 27 points
  128. * espace de référence de dimension 3
  129. *
  130. * In INIPG : SEGINI PGCOUR
  131. CALL INIPG('GAPY-5-27','GAUSS','PYRAMIDE',
  132. $ 5,27,3,
  133. $ PGCOUR,
  134. $ IMPR,IRET)
  135. IF (IRET.NE.0) GOTO 9999
  136. NBG=27
  137. IELE=25
  138. * In SMI2PG : SEGDES PGCOUR
  139. CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
  140. IF (IRET.NE.0) GOTO 9999
  141. MYPGS.LISPG(**)=PGCOUR
  142. *
  143. * Normal termination
  144. *
  145. IRET=0
  146. RETURN
  147. *
  148. * Format handling
  149. *
  150. *
  151. * Error handling
  152. *
  153. 9999 CONTINUE
  154. IRET=1
  155. WRITE(IOIMP,*) 'An error was detected in subroutine ingapy'
  156. RETURN
  157. *
  158. * End of subroutine INGAPY
  159. *
  160. END
  161.  
  162.  
  163.  
  164.  

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