Télécharger cogauf.eso

Retour à la liste

Numérotation des lignes :

cogauf
  1. C COGAUF SOURCE GOUNAND 21/06/02 21:15:29 11022
  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 SMTNLIN)
  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.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC TNLIN
  40. *-INC SFACTIV
  41. *-INC SMCHAEL
  42. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  43. POINTEUR JCOEFF.MCHEVA
  44. POINTEUR JCOEFG.MCHEVA
  45. * Valeurs des fns d'interpolation du coeff. aux points de Gauss
  46. POINTEUR FFPG.MCHEVA
  47. *
  48. INTEGER IMPR,IRET
  49. *
  50. * Executable statements
  51. *
  52. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cogauf'
  53. SEGACT SSFACT
  54. NBELFV=SSFACT.LFACTI(/1)
  55. NBELEV=SSFACT.LFACTI(/2)
  56. SEGACT JCOEFF
  57. NDLIG =JCOEFF.WELCHE(/1)
  58. NDCOL =JCOEFF.WELCHE(/2)
  59. N2DLIG=JCOEFF.WELCHE(/3)
  60. N2DCOL=JCOEFF.WELCHE(/4)
  61. NDNOEU=JCOEFF.WELCHE(/5)
  62. NBELEM=JCOEFF.WELCHE(/6)
  63. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.N2DCOL.NE.1
  64. $ .OR.NDNOEU.NE.1
  65. $ .OR.(NBELEM.NE.1.AND.NBELEM.NE.NBELEV)) THEN
  66. WRITE(IOIMP,*) 'Erreur dims JCOEFF'
  67. GOTO 9999
  68. ENDIF
  69. NDDL=NDCOL
  70. NLVCOF=NBELEM
  71. SEGACT FFPG
  72. NDLIG =FFPG.WELCHE(/1)
  73. NDCOL =FFPG.WELCHE(/2)
  74. N2DLIG=FFPG.WELCHE(/3)
  75. N2DCOL=FFPG.WELCHE(/4)
  76. NDNOEU=FFPG.WELCHE(/5)
  77. NBELEM=FFPG.WELCHE(/6)
  78. IF (NDLIG.NE.1.OR.NDCOL.NE.NDDL
  79. $ .OR.N2DLIG.NE.1.OR.N2DCOL.NE.1
  80. $ .OR.(NBELEM.NE.1.AND.NBELEM.NE.NBELFV)) THEN
  81. WRITE(IOIMP,*) 'Erreur dims FFPG'
  82. GOTO 9999
  83. ENDIF
  84. NBPOGO=NDNOEU
  85. NLFVFF=NBELEM
  86. IF (NLVCOF.EQ.1.AND.NLFVFF.EQ.1) THEN
  87. NLFCOG=1
  88. ELSE
  89. NLFCOG=NBELEF
  90. ENDIF
  91. *
  92. * Initialisations...
  93. *
  94. NBLIG=1
  95. NBCOL=1
  96. N2LIG=1
  97. N2COL=1
  98. NBPOI=NBPOGO
  99. NBELM=NLFCOG
  100. SEGINI JCOEFG
  101. *
  102. * On effectue le calcul du coefficient aux points de Gauss
  103. *
  104. CALL COGAF1(NDDL,NBPOGO,NBELEV,NBELFV,NBELEF,
  105. $ NLVCOF,NLFVFF,NLFCOG,
  106. $ JCOEFF.WELCHE,FFPG.WELCHE,SSFACT.LFACTI,
  107. $ JCOEFG.WELCHE,
  108. $ IMPR,IRET)
  109. IF (IRET.NE.0) GOTO 9999
  110. SEGDES JCOEFG
  111. SEGDES SSFACT
  112. SEGDES JCOEFF
  113. SEGDES FFPG
  114. *
  115. * Normal termination
  116. *
  117. IRET=0
  118. RETURN
  119. *
  120. * Format handling
  121. *
  122. *
  123. * Error handling
  124. *
  125. 9999 CONTINUE
  126. IRET=1
  127. WRITE(IOIMP,*) 'An error was detected in subroutine cogauf'
  128. RETURN
  129. *
  130. * End of subroutine COGAUF
  131. *
  132. END
  133.  
  134.  
  135.  
  136.  

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