Télécharger cogaf1.eso

Retour à la liste

Numérotation des lignes :

  1. C COGAF1 SOURCE GOUNAND 06/08/04 21:15:02 5520
  2. SUBROUTINE COGAF1(NDDL,NBPOGO,NBELEV,NBELFV,NBELEF,
  3. $ NLVCOF,NLFVFF,NLFCOG,
  4. $ JCOEFF,FFPG,SSFACT,
  5. $ JCOEFG,
  6. $ IMPR,IRET)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM : COGAF1
  11. C PROJET : Noyau linéaire NLIN
  12. C DESCRIPTION :
  13. C
  14. C LANGAGE : Fortran 77 (sauf E/S)
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES : -
  19. C APPELE PAR : COGAUF
  20. C***********************************************************************
  21. C ENTREES :
  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. INTEGER NDDL,NBPOGO,NBELEV,NBELFV,NBELEF
  38. REAL*8 JCOEFF (NDDL,NLVCOF)
  39. REAL*8 FFPG (NDDL,NBPOGO,NLFVFF)
  40. LOGICAL SSFACT(NBELFV,NBELEV)
  41. REAL*8 JCOEFG(NBPOGO,NLFCOG)
  42. *
  43. INTEGER IMPR,IRET
  44. INTEGER IBPOGO,IDDL,IBELEV,IBELEF,IBELFV
  45. *
  46. * Executable statements
  47. *
  48. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cogaf1'
  49. IF (NLFCOG.EQ.1) THEN
  50. IF (NLVCOF.NE.1.OR.NLFVFF.NE.1) THEN
  51. WRITE(IOIMP,*) 'Erreur grave 1'
  52. GOTO 9999
  53. ENDIF
  54. DO IBPOGO=1,NBPOGO
  55. DO IDDL=1,NDDL
  56. JCOEFG(IBPOGO,1)=JCOEFG(IBPOGO,1)+
  57. $ ( FFPG(IDDL,IBPOGO,1)
  58. $ *JCOEFF(IDDL,1))
  59. ENDDO
  60. ENDDO
  61. ELSEIF (NLFCOG.EQ.NBELEF) THEN
  62. IBELEF=0
  63. DO IBELEV=1,NBELEV
  64. DO IBELFV=1,NBELFV
  65. IF (SSFACT(IBELFV,IBELEV)) THEN
  66. IF (NLVCOF.EQ.1) THEN
  67. ILVCOF=1
  68. ELSE
  69. ILVCOF=IBELEV
  70. ENDIF
  71. IF (NLFVFF.EQ.1) THEN
  72. ILFVFF=1
  73. ELSE
  74. ILFVFF=IBELFV
  75. ENDIF
  76. IBELEF=IBELEF+1
  77. DO IBPOGO=1,NBPOGO
  78. DO IDDL=1,NDDL
  79. JCOEFG(IBPOGO,IBELEF)=
  80. $ JCOEFG(IBPOGO,IBELEF)
  81. $ + (JCOEFF(IDDL,ILVCOF)
  82. $ *FFPG(IDDL,IBPOGO,ILFVFF))
  83. ENDDO
  84. ENDDO
  85. ENDIF
  86. ENDDO
  87. ENDDO
  88. ELSE
  89. WRITE(IOIMP,*) 'Erreur grave 2'
  90. GOTO 9999
  91. ENDIF
  92. *
  93. * Normal termination
  94. *
  95. IRET=0
  96. RETURN
  97. *
  98. * Format handling
  99. *
  100. *
  101. * Error handling
  102. *
  103. 9999 CONTINUE
  104. IRET=1
  105. WRITE(IOIMP,*) 'An error was detected in subroutine cogaf1'
  106. RETURN
  107. *
  108. * End of subroutine COGAF1
  109. *
  110. END
  111.  
  112.  
  113.  

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