Télécharger ccgsut.eso

Retour à la liste

Numérotation des lignes :

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

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