Télécharger ccgras.eso

Retour à la liste

Numérotation des lignes :

  1. C CCGRAS SOURCE GOUNAND 05/12/21 21:16:45 5281
  2. SUBROUTINE CCGRAS(LCOF,
  3. $ FC,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : CCGRAS
  9. C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss :
  10. C un rayonnement en surface
  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 ENTREES/SORTIES :
  22. C SORTIES : -
  23. C TRAVAIL :
  24. C***********************************************************************
  25. C VERSION : v1, 10/09/04, version initiale
  26. C HISTORIQUE : v1, 10/09/04, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34. -INC CCOPTIO
  35. CBEGININCLUDE SMCHAEL
  36. SEGMENT MCHAEL
  37. POINTEUR IMACHE(N1).MELEME
  38. POINTEUR ICHEVA(N1).MCHEVA
  39. ENDSEGMENT
  40. SEGMENT MCHEVA
  41. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  42. ENDSEGMENT
  43. SEGMENT LCHEVA
  44. POINTEUR LISCHE(NBCHE).MCHEVA
  45. ENDSEGMENT
  46. CENDINCLUDE SMCHAEL
  47. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  48. POINTEUR FC.MCHEVA
  49. POINTEUR LCOF.LCHEVA
  50. POINTEUR T1.MCHEVA
  51. POINTEUR T2.MCHEVA
  52. POINTEUR T3.MCHEVA
  53. *
  54. INTEGER IMPR,IRET
  55. *
  56. * Executable statements
  57. *
  58. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgras'
  59. NLFC=FC.VELCHE(/6)
  60. NPFC=FC.VELCHE(/5)
  61. T1=LCOF.LISCHE(1)
  62. T2=LCOF.LISCHE(2)
  63. T3=LCOF.LISCHE(3)
  64. NLC1=T1.VELCHE(/6)
  65. NPC1=T1.VELCHE(/5)
  66. NLC2=T2.VELCHE(/6)
  67. NPC2=T2.VELCHE(/5)
  68. NLC3=T3.VELCHE(/6)
  69. NPC3=T3.VELCHE(/5)
  70. DO ILFC=1,NLFC
  71. IF (NLC1.EQ.1) THEN
  72. ILC1=1
  73. ELSE
  74. ILC1=ILFC
  75. ENDIF
  76. IF (NLC2.EQ.1) THEN
  77. ILC2=1
  78. ELSE
  79. ILC2=ILFC
  80. ENDIF
  81. IF (NLC3.EQ.1) THEN
  82. ILC3=1
  83. ELSE
  84. ILC3=ILFC
  85. ENDIF
  86. DO IPFC=1,NPFC
  87. IF (NPC1.EQ.1) THEN
  88. IPC1=1
  89. ELSE
  90. IPC1=IPFC
  91. ENDIF
  92. IF (NPC2.EQ.1) THEN
  93. IPC2=1
  94. ELSE
  95. IPC2=IPFC
  96. ENDIF
  97. IF (NPC3.EQ.1) THEN
  98. IPC3=1
  99. ELSE
  100. IPC3=IPFC
  101. ENDIF
  102. XT1=T1.VELCHE(1,1,1,1,IPC1,ILC1)
  103. XT2=T2.VELCHE(1,1,1,1,IPC2,ILC2)
  104. XT3=T3.VELCHE(1,1,1,1,IPC3,ILC3)
  105. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  106. $ XT1*XT2*XT3**3
  107. ENDDO
  108. ENDDO
  109. *
  110. * Normal termination
  111. *
  112. IRET=0
  113. RETURN
  114. *
  115. * Format handling
  116. *
  117. *
  118. * Error handling
  119. *
  120. 9999 CONTINUE
  121. IRET=1
  122. WRITE(IOIMP,*) 'An error was detected in subroutine ccgras'
  123. RETURN
  124. *
  125. * End of subroutine CCGRAS
  126. *
  127. END
  128.  
  129.  
  130.  

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