Télécharger gcfs2.eso

Retour à la liste

Numérotation des lignes :

  1. C GCFS2 SOURCE GOUNAND 05/12/21 21:24:27 5281
  2. SUBROUTINE GCFS2(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 : GCFS2
  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 [ Fully symmetric region ]
  12. C i.e. segment, carré et cube pour nous.
  13. C Générateur de type [ Fully symmetric ].
  14. C Rule structure of index 2 i.e.
  15. C XCOR=(a,0,...,0)
  16. C
  17. C le nombre de points générés est 2*DIMSRF :
  18. C (a,0,...,0), (-a,0,...,0)
  19. C (0,a,...,0), (0,-a,...,0) et les autres permutations
  20. C
  21. C LANGAGE : ESOPE
  22. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  23. C mél : gounand@semt2.smts.cea.fr
  24. C***********************************************************************
  25. C APPELES : -
  26. C APPELE PAR : INGACU
  27. C***********************************************************************
  28. C ENTREES : DIMSRF, XCOR, POIDS
  29. C ENTREES/SORTIES : PGCOUR (actif en *MOD), NOPG
  30. C SORTIES : MYPGS
  31. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  32. C***********************************************************************
  33. C VERSION : v1, 20/10/99, version initiale
  34. C HISTORIQUE : v1, 20/10/99, création
  35. C HISTORIQUE :
  36. C HISTORIQUE :
  37. C***********************************************************************
  38. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  39. C en cas de modification de ce sous-programme afin de faciliter
  40. C la maintenance !
  41. C***********************************************************************
  42.  
  43. -INC PPARAM
  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)
  62. REAL*8 POIDS
  63. INTEGER IMPR,IRET
  64. *
  65. INTEGER IPERM,ISIGN,ICOOP
  66. *
  67. * Executable statements
  68. *
  69. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans gcfs2'
  70. *
  71. * Boucle sur les permutations
  72. DO 1 IPERM=1,DIMSRF
  73. * Boucle sur le signe
  74. DO 12 ISIGN=1,2
  75. NOPG=NOPG+1
  76. * Boucle sur les coordonnées du point
  77. DO 122 ICOOP=1,DIMSRF
  78. IF (ICOOP.EQ.IPERM) THEN
  79. PGCOUR.XCOPG(ICOOP,NOPG)=
  80. $ DBLE((-1)**ISIGN)
  81. $ *XCOR(1)
  82. ELSE
  83. PGCOUR.XCOPG(ICOOP,NOPG)=0.D0
  84. ENDIF
  85. 122 CONTINUE
  86. PGCOUR.XPOPG(NOPG)=POIDS
  87. 12 CONTINUE
  88. 1 CONTINUE
  89. *
  90. * Normal termination
  91. *
  92. IRET=0
  93. RETURN
  94. *
  95. * Format handling
  96. *
  97. *
  98. * Error handling
  99. *
  100. 9999 CONTINUE
  101. IRET=1
  102. WRITE(IOIMP,*) 'An error was detected in subroutine gcfs2'
  103. RETURN
  104. *
  105. * End of subroutine GCFS2
  106. *
  107. END
  108.  
  109.  
  110.  
  111.  

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