Télécharger cogau.eso

Retour à la liste

Numérotation des lignes :

  1. C COGAU SOURCE GOUNAND 05/12/21 21:17:16 5281
  2. SUBROUTINE COGAU(JCOEF,FNCOPG,
  3. $ JCOEFG,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : COGAU
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Calcul du coefficient aux points de Gauss d'un élément
  11. C de référence pour chaque élément réel.
  12. C Le coefficient peut être scalaire, vectoriel ou
  13. C tensoriel. Les fonctions d'interpolation seront les
  14. C mêmes pour chaque composante du vecteur ou chaque
  15. C coefficient des matrices.
  16. C Les valeurs nodales devront être exprimées par rapport
  17. C aux coordonnées de l'espace de référence (par exemple,
  18. C s'il y a des dérivées, elles devront être exprimées par
  19. C rapport à ksi, eta...)
  20. C Si les valeurs sont des variables généralisées, il n'y
  21. C a peut-être rien à faire. (?)
  22. C
  23. C
  24. C LANGAGE : ESOPE
  25. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  26. C mél : gounand@semt2.smts.cea.fr
  27. C***********************************************************************
  28. C APPELES : PRCHVA (impression d'un segment de type MCHEVA)
  29. C COGA1 (calcul de JCOEFG (fortran 77))
  30. C APPELE PAR : NLIN
  31. C***********************************************************************
  32. C ENTREES : * JCOEF (type MCHEVA) : valeurs des ddl du
  33. C coefficient tensoriel sur le maillage
  34. C élémentaire courant.
  35. C Structure (cf.include SMCHAEL) :
  36. C (1, nb. ddl, nb. comp. duales,
  37. C nb. comp. primales, 1, nb. éléments)
  38. C * FNCOPG (type MCHEVA) : valeurs des fonctions
  39. C d'interpolation pour le coefficient aux points
  40. C de gauss sur l'élément de référence.
  41. C Structure (cf.include SMCHAEL) :
  42. C (1, nb. ddl, 1, dim.esp.réf, nb. poi. gauss, 1)
  43. C
  44. C ENTREES/SORTIES : -
  45. C SORTIES : * JCOEFG (type MCHEVA) : valeurs du coefficient
  46. C tensoriel aux points de Gauss sur le maillage
  47. C élémentaire.
  48. C Structure (cf.include SMCHAEL) :
  49. C (1, 1, nb. comp. duales, nb. comp. primales,
  50. C nb. poi. gauss, nb. éléments)
  51. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  52. C***********************************************************************
  53. C VERSION : v1, 17/08/99, version initiale
  54. C HISTORIQUE : v1, 17/08/99, création
  55. C HISTORIQUE :
  56. C HISTORIQUE :
  57. C***********************************************************************
  58. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  59. C en cas de modification de ce sous-programme afin de faciliter
  60. C la maintenance !
  61. C***********************************************************************
  62. -INC CCOPTIO
  63. CBEGININCLUDE SMCHAEL
  64. SEGMENT MCHAEL
  65. POINTEUR IMACHE(N1).MELEME
  66. POINTEUR ICHEVA(N1).MCHEVA
  67. ENDSEGMENT
  68. SEGMENT MCHEVA
  69. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  70. ENDSEGMENT
  71. SEGMENT LCHEVA
  72. POINTEUR LISCHE(NBCHE).MCHEVA
  73. ENDSEGMENT
  74. CENDINCLUDE SMCHAEL
  75. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  76. POINTEUR JCOEF.MCHEVA
  77. POINTEUR JCOEFG.MCHEVA
  78. * Valeurs des fns d'interpolation du coeff. aux points de Gauss
  79. POINTEUR FNCOPG.MCHEVA
  80. *
  81. INTEGER IMPR,IRET
  82. *
  83. INTEGER NDLIG,NDCOL,ND2LI,ND2CO
  84. INTEGER NDPOGO,NDELEM,NDNOEU,NDNOE2
  85. *
  86. * Executable statements
  87. *
  88. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cogau'
  89. SEGACT FNCOPG
  90. NDNOEU=FNCOPG.VELCHE(/2)
  91. NDPOGO=FNCOPG.VELCHE(/5)
  92. SEGACT JCOEF
  93. NDLIG=JCOEF.VELCHE(/1)
  94. NDNOE2=JCOEF.VELCHE(/5)
  95. IF (NDLIG.NE.1.OR.NDNOE2.NE.1) THEN
  96. WRITE(IOIMP,*) 'Erreur dims JCOEF'
  97. GOTO 9999
  98. ENDIF
  99. NDCOL=JCOEF.VELCHE(/2)
  100. ND2LI=JCOEF.VELCHE(/3)
  101. ND2CO=JCOEF.VELCHE(/4)
  102. NDELEM=JCOEF.VELCHE(/6)
  103. IF (NDCOL.NE.NDNOEU) THEN
  104. WRITE(IOIMP,*) 'Incompatibilité fns interpolation-coefficient'
  105. WRITE(IOIMP,*) 'NDNOEU=',NDNOEU,' NDCOL=',NDCOL
  106. GOTO 9999
  107. ENDIF
  108. *
  109. * Initialisations...
  110. *
  111. NBLIG=1
  112. NBCOL=1
  113. N2LIG=ND2LI
  114. N2COL=ND2CO
  115. NBPOI=NDPOGO
  116. NBELM=NDELEM
  117. SEGINI JCOEFG
  118. *
  119. * On effectue le calcul du coefficient aux points de Gauss
  120. *
  121. CALL COGA1(ND2LI,ND2CO,NDNOEU,NDPOGO,NDELEM,
  122. * $ JCOEF.VELCHE,MFFCPG.FNPG,
  123. $ JCOEF.VELCHE,FNCOPG.VELCHE,
  124. $ JCOEFG.VELCHE,
  125. $ IMPR,IRET)
  126. IF (IRET.NE.0) GOTO 9999
  127. SEGDES JCOEFG
  128. SEGDES JCOEF
  129. * SEGDES MFFCPG
  130. SEGDES FNCOPG
  131. IF (IMPR.GT.3) THEN
  132. WRITE(IOIMP,*) 'On a créé',
  133. $ ' JCOEFG(élément , poi.gauss ,',
  134. $ ' comp.pri , comp.dua ,1,1)'
  135. CALL PRCHVA(JCOEFG,IMPR,IRET)
  136. IF (IRET.NE.0) GOTO 9999
  137. ENDIF
  138. *
  139. * Normal termination
  140. *
  141. IRET=0
  142. RETURN
  143. *
  144. * Format handling
  145. *
  146. *
  147. * Error handling
  148. *
  149. 9999 CONTINUE
  150. IRET=1
  151. WRITE(IOIMP,*) 'An error was detected in subroutine cogau'
  152. RETURN
  153. *
  154. * End of subroutine COGAU
  155. *
  156. END
  157.  
  158.  
  159.  

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