Télécharger ccgsut.eso

Retour à la liste

Numérotation des lignes :

  1. C CCGSUT SOURCE GOUNAND 05/12/21 21:16:52 5281
  2. SUBROUTINE CCGSUT(LCOF,
  3. $ FC,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : CCGSUT
  9. C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss :
  10. C une divergence
  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, 12/05/04, version initiale
  26. C HISTORIQUE : v1, 12/05/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 ccgsut'
  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)**1.5D0)
  107. $ *((XT2+XT3)/(XT1+XT3))
  108. ENDDO
  109. ENDDO
  110. *
  111. * Normal termination
  112. *
  113. IRET=0
  114. RETURN
  115. *
  116. * Format handling
  117. *
  118. *
  119. * Error handling
  120. *
  121. 9999 CONTINUE
  122. IRET=1
  123. WRITE(IOIMP,*) 'An error was detected in subroutine ccgsut'
  124. RETURN
  125. *
  126. * End of subroutine CCGSUT
  127. *
  128. END
  129.  
  130.  
  131.  

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