Télécharger ccgras.eso

Retour à la liste

Numérotation des lignes :

ccgras
  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.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. CBEGININCLUDE SMCHAEL
  38. SEGMENT MCHAEL
  39. POINTEUR IMACHE(N1).MELEME
  40. POINTEUR ICHEVA(N1).MCHEVA
  41. ENDSEGMENT
  42. SEGMENT MCHEVA
  43. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  44. ENDSEGMENT
  45. SEGMENT LCHEVA
  46. POINTEUR LISCHE(NBCHE).MCHEVA
  47. ENDSEGMENT
  48. CENDINCLUDE SMCHAEL
  49. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  50. POINTEUR FC.MCHEVA
  51. POINTEUR LCOF.LCHEVA
  52. POINTEUR T1.MCHEVA
  53. POINTEUR T2.MCHEVA
  54. POINTEUR T3.MCHEVA
  55. *
  56. INTEGER IMPR,IRET
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgras'
  61. NLFC=FC.VELCHE(/6)
  62. NPFC=FC.VELCHE(/5)
  63. T1=LCOF.LISCHE(1)
  64. T2=LCOF.LISCHE(2)
  65. T3=LCOF.LISCHE(3)
  66. NLC1=T1.VELCHE(/6)
  67. NPC1=T1.VELCHE(/5)
  68. NLC2=T2.VELCHE(/6)
  69. NPC2=T2.VELCHE(/5)
  70. NLC3=T3.VELCHE(/6)
  71. NPC3=T3.VELCHE(/5)
  72. DO ILFC=1,NLFC
  73. IF (NLC1.EQ.1) THEN
  74. ILC1=1
  75. ELSE
  76. ILC1=ILFC
  77. ENDIF
  78. IF (NLC2.EQ.1) THEN
  79. ILC2=1
  80. ELSE
  81. ILC2=ILFC
  82. ENDIF
  83. IF (NLC3.EQ.1) THEN
  84. ILC3=1
  85. ELSE
  86. ILC3=ILFC
  87. ENDIF
  88. DO IPFC=1,NPFC
  89. IF (NPC1.EQ.1) THEN
  90. IPC1=1
  91. ELSE
  92. IPC1=IPFC
  93. ENDIF
  94. IF (NPC2.EQ.1) THEN
  95. IPC2=1
  96. ELSE
  97. IPC2=IPFC
  98. ENDIF
  99. IF (NPC3.EQ.1) THEN
  100. IPC3=1
  101. ELSE
  102. IPC3=IPFC
  103. ENDIF
  104. XT1=T1.VELCHE(1,1,1,1,IPC1,ILC1)
  105. XT2=T2.VELCHE(1,1,1,1,IPC2,ILC2)
  106. XT3=T3.VELCHE(1,1,1,1,IPC3,ILC3)
  107. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  108. $ XT1*XT2*XT3**3
  109. ENDDO
  110. ENDDO
  111. *
  112. * Normal termination
  113. *
  114. IRET=0
  115. RETURN
  116. *
  117. * Format handling
  118. *
  119. *
  120. * Error handling
  121. *
  122. 9999 CONTINUE
  123. IRET=1
  124. WRITE(IOIMP,*) 'An error was detected in subroutine ccgras'
  125. RETURN
  126. *
  127. * End of subroutine CCGRAS
  128. *
  129. END
  130.  
  131.  
  132.  

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