Télécharger gt3fs9.eso

Retour à la liste

Numérotation des lignes :

  1. C GT3FS9 SOURCE GOUNAND 05/12/21 21:29:04 5281
  2. SUBROUTINE GT3FS9(PGCOUR,NOPG,DIMSRF,XCOR,POIDS,
  3. $ IMPR,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : GT3FS9
  8. C PROJET : Noyau linéaire NLIN
  9. C DESCRIPTION : Rajoute des points à une méthode d'intégration type
  10. C Gauss (PGCOUR).
  11. C Domaine de type [ Simplex ] de dimension 3
  12. C i.e. tétrahèdre.
  13. C Générateur de type [ Fully symmetric ].
  14. C Rule structure of index 9 i.e.
  15. C XCOR=(a,a,b,b)
  16. C XCOR=xi sont les coordonnées barycentriques...
  17. C
  18. C le nombre de points générés est 6 (car le nombre de
  19. C permutations distinctes de (a,a,b,b) est 4!/(2!2!) :
  20. C (a,a,b,b) ; (a,b,a,b) ; (a,b,b,a)
  21. C (b,a,b,a) ; (b,b,a,a) ; (b,a,a,b)
  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 : -
  28. C APPELE PAR : INGATE
  29. C***********************************************************************
  30. C ENTREES : DIMSRF, XCOR, POIDS
  31. C ENTREES/SORTIES : PGCOUR (actif en *MOD), NOPG
  32. C SORTIES : MYPGS
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION : v1, 20/10/99, version initiale
  36. C HISTORIQUE : v1, 20/10/99, 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 PGCOUR.POGAU
  59. *
  60. INTEGER NOPG,DIMSRF
  61. REAL*8 XCOR(DIMSRF+1)
  62. REAL*8 POIDS
  63. INTEGER IMPR,IRET
  64. *
  65. REAL*8 XA,XB
  66. *
  67. * Executable statements
  68. *
  69. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans gt3fs9'
  70. IF (DIMSRF.NE.3) THEN
  71. WRITE(IOIMP,*) 'DIMSRF doit etre égal à 3...'
  72. GOTO 9999
  73. ENDIF
  74. XA=XCOR(1)
  75. XB=XCOR(3)
  76. * (a,a,b,b) ; (a,b,a,b) ; (a,b,b,a)
  77. NOPG=NOPG+1
  78. PGCOUR.XCOPG(1,NOPG)= XA
  79. PGCOUR.XCOPG(2,NOPG)= XA
  80. PGCOUR.XCOPG(3,NOPG)= XB
  81. PGCOUR.XPOPG(NOPG)=POIDS
  82. NOPG=NOPG+1
  83. PGCOUR.XCOPG(1,NOPG)= XA
  84. PGCOUR.XCOPG(2,NOPG)= XB
  85. PGCOUR.XCOPG(3,NOPG)= XA
  86. PGCOUR.XPOPG(NOPG)=POIDS
  87. NOPG=NOPG+1
  88. PGCOUR.XCOPG(1,NOPG)= XA
  89. PGCOUR.XCOPG(2,NOPG)= XB
  90. PGCOUR.XCOPG(3,NOPG)= XB
  91. PGCOUR.XPOPG(NOPG)=POIDS
  92. * (b,a,b,a) ; (b,b,a,a) ; (b,a,a,b)
  93. NOPG=NOPG+1
  94. PGCOUR.XCOPG(1,NOPG)= XB
  95. PGCOUR.XCOPG(2,NOPG)= XA
  96. PGCOUR.XCOPG(3,NOPG)= XB
  97. PGCOUR.XPOPG(NOPG)=POIDS
  98. NOPG=NOPG+1
  99. PGCOUR.XCOPG(1,NOPG)= XB
  100. PGCOUR.XCOPG(2,NOPG)= XB
  101. PGCOUR.XCOPG(3,NOPG)= XA
  102. PGCOUR.XPOPG(NOPG)=POIDS
  103. NOPG=NOPG+1
  104. PGCOUR.XCOPG(1,NOPG)= XB
  105. PGCOUR.XCOPG(2,NOPG)= XA
  106. PGCOUR.XCOPG(3,NOPG)= XA
  107. PGCOUR.XPOPG(NOPG)=POIDS
  108. *
  109. * Normal termination
  110. *
  111. IRET=0
  112. RETURN
  113. *
  114. * Format handling
  115. *
  116. *
  117. * Error handling
  118. *
  119. 9999 CONTINUE
  120. IRET=1
  121. WRITE(IOIMP,*) 'An error was detected in subroutine gt3fs9'
  122. RETURN
  123. *
  124. * End of subroutine GT3FS9
  125. *
  126. END
  127.  
  128.  
  129.  
  130.  

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