Télécharger cogauf.eso

Retour à la liste

Numérotation des lignes :

  1. C COGAUF SOURCE GOUNAND 06/08/04 21:15:10 5520
  2. SUBROUTINE COGAUF(JCOEFF,FFPG,SSFACT,NBELEF,
  3. $ JCOEFG,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : COGAUF
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION :
  11. C
  12. C
  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 :
  18. C APPELE PAR :
  19. C***********************************************************************
  20. C ENTREES :
  21. C
  22. C ENTREES/SORTIES : -
  23. C SORTIES :
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v2, 03/10/03, refonte complète (modif SMPOUET)
  27. C VERSION : v1, 17/01/03, version initiale
  28. C HISTORIQUE : v1, 17/01/03, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36. -INC CCOPTIO
  37. CBEGININCLUDE SFACTIV
  38. SEGMENT FACTIV
  39. POINTEUR IFACTI(NBSOUV).SFACTI
  40. ENDSEGMENT
  41. SEGMENT SFACTI
  42. POINTEUR ISFACT(NBSOFV).SSFACT
  43. ENDSEGMENT
  44. SEGMENT SSFACT
  45. LOGICAL LFACTI(NBELFV,NBELEV)
  46. ENDSEGMENT
  47. CENDINCLUDE SFACTIV
  48. CBEGININCLUDE SMCHAEL
  49. SEGMENT MCHAEL
  50. POINTEUR IMACHE(N1).MELEME
  51. POINTEUR ICHEVA(N1).MCHEVA
  52. ENDSEGMENT
  53. SEGMENT MCHEVA
  54. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  55. ENDSEGMENT
  56. SEGMENT LCHEVA
  57. POINTEUR LISCHE(NBCHE).MCHEVA
  58. ENDSEGMENT
  59. CENDINCLUDE SMCHAEL
  60. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  61. POINTEUR JCOEFF.MCHEVA
  62. POINTEUR JCOEFG.MCHEVA
  63. * Valeurs des fns d'interpolation du coeff. aux points de Gauss
  64. POINTEUR FFPG.MCHEVA
  65. *
  66. INTEGER IMPR,IRET
  67. *
  68. * Executable statements
  69. *
  70. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cogauf'
  71. SEGACT SSFACT
  72. NBELFV=SSFACT.LFACTI(/1)
  73. NBELEV=SSFACT.LFACTI(/2)
  74. SEGACT JCOEFF
  75. NDLIG =JCOEFF.VELCHE(/1)
  76. NDCOL =JCOEFF.VELCHE(/2)
  77. N2DLIG=JCOEFF.VELCHE(/3)
  78. N2DCOL=JCOEFF.VELCHE(/4)
  79. NDNOEU=JCOEFF.VELCHE(/5)
  80. NBELEM=JCOEFF.VELCHE(/6)
  81. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.N2DCOL.NE.1
  82. $ .OR.NDNOEU.NE.1
  83. $ .OR.(NBELEM.NE.1.AND.NBELEM.NE.NBELEV)) THEN
  84. WRITE(IOIMP,*) 'Erreur dims JCOEFF'
  85. GOTO 9999
  86. ENDIF
  87. NDDL=NDCOL
  88. NLVCOF=NBELEM
  89. SEGACT FFPG
  90. NDLIG =FFPG.VELCHE(/1)
  91. NDCOL =FFPG.VELCHE(/2)
  92. N2DLIG=FFPG.VELCHE(/3)
  93. N2DCOL=FFPG.VELCHE(/4)
  94. NDNOEU=FFPG.VELCHE(/5)
  95. NBELEM=FFPG.VELCHE(/6)
  96. IF (NDLIG.NE.1.OR.NDCOL.NE.NDDL
  97. $ .OR.N2DLIG.NE.1.OR.N2DCOL.NE.1
  98. $ .OR.(NBELEM.NE.1.AND.NBELEM.NE.NBELFV)) THEN
  99. WRITE(IOIMP,*) 'Erreur dims FFPG'
  100. GOTO 9999
  101. ENDIF
  102. NBPOGO=NDNOEU
  103. NLFVFF=NBELEM
  104. IF (NLVCOF.EQ.1.AND.NLFVFF.EQ.1) THEN
  105. NLFCOG=1
  106. ELSE
  107. NLFCOG=NBELEF
  108. ENDIF
  109. *
  110. * Initialisations...
  111. *
  112. NBLIG=1
  113. NBCOL=1
  114. N2LIG=1
  115. N2COL=1
  116. NBPOI=NBPOGO
  117. NBELM=NLFCOG
  118. SEGINI JCOEFG
  119. *
  120. * On effectue le calcul du coefficient aux points de Gauss
  121. *
  122. CALL COGAF1(NDDL,NBPOGO,NBELEV,NBELFV,NBELEF,
  123. $ NLVCOF,NLFVFF,NLFCOG,
  124. $ JCOEFF.VELCHE,FFPG.VELCHE,SSFACT.LFACTI,
  125. $ JCOEFG.VELCHE,
  126. $ IMPR,IRET)
  127. IF (IRET.NE.0) GOTO 9999
  128. SEGDES JCOEFG
  129. SEGDES SSFACT
  130. SEGDES JCOEFF
  131. SEGDES FFPG
  132. *
  133. * Normal termination
  134. *
  135. IRET=0
  136. RETURN
  137. *
  138. * Format handling
  139. *
  140. *
  141. * Error handling
  142. *
  143. 9999 CONTINUE
  144. IRET=1
  145. WRITE(IOIMP,*) 'An error was detected in subroutine cogauf'
  146. RETURN
  147. *
  148. * End of subroutine COGAUF
  149. *
  150. END
  151.  
  152.  
  153.  

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