Télécharger ottove.eso

Retour à la liste

Numérotation des lignes :

  1. C OTTOVE SOURCE CHAT 05/01/13 02:07:58 5004
  2. SUBROUTINE OTTOVE(NCRIT,JCRIT,SIGMA,W,WMAX,WRUPT,SMAX,
  3. & BTR,XLTR,XINVL,BILIN,SBILI,PRECIE,PRECIZ,DEFPLA,
  4. & NN,NC,NCA,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
  5. & XCOMP,XLAMC,KERRE)
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. -INC CCOPTIO
  10. C
  11. PARAMETER (XZER=0.D0)
  12. PARAMETER (UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  13. C
  14. DIMENSION SIGMA(*),W(*),WMAX(*),BILIN(*),
  15. & WRUPT(*),XLTR(*),XINVL(*),SBILI(*)
  16. DIMENSION PENTE(*),PENTE2(*),XCOMP(*)
  17. DIMENSION FC(*),FC2(*),NN(*),LEBIL(*),SMAX(*)
  18. DIMENSION DEFPLA(*),ISING(*)
  19. DIMENSION JCRIT(*)
  20. DIMENSION ZOB(3)
  21. *
  22. KERRE=0
  23. *
  24. *
  25. DO I=1,3
  26. IF(ABS(WMAX(I)-WRUPT(I)).LT.WRUPT(I)*PRECIE) THEN
  27. IF(W(I).EQ.WMAX(I)) THEN
  28. W(I)=WRUPT(I)
  29. ENDIF
  30. WMAX(I)=WRUPT(I)
  31. SMAX(I)=0.D0
  32. ENDIF
  33. ENDDO
  34. *
  35. * PURGE
  36. *
  37. DO I=1,6
  38. IF(ABS(DEFPLA(I)).LT.PRECIE*1.D-2) DEFPLA(I)=0.D0
  39. ENDDO
  40. *
  41. *
  42. DO IC=1,NCRIT
  43. JC=JCRIT(IC)
  44. *
  45. * CAS DE REOUVERTURE
  46. *
  47. IF(JC.GE.10.AND.JC.LE.12) THEN
  48. KC=JC-9
  49. SIGMA(KC)=0.D0
  50. W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC))
  51. *
  52. * CAS DE REFERMETURE
  53. *
  54. ELSE IF(JC.GE.13.AND.JC.LE.15) THEN
  55. KC=JC-12
  56. SIGMA(KC)=0.D0
  57. W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC))
  58. *
  59. * CAS DE RUPTURE
  60. *
  61. ELSE IF(JC.GE.7.AND.JC.LE.9) THEN
  62. KC=JC-6
  63. SIGMA(KC)=0.D0
  64. W(KC)=WRUPT(KC)
  65. WMAX(KC)=WRUPT(KC)
  66. SMAX(KC)=0.D0
  67. *
  68. * CAS DE FISSURATION
  69. *
  70. ELSE IF(JC.GE.1.AND.JC.LE.3) THEN
  71. IF(ISING(JC).EQ.2) THEN
  72. SIGMA(JC)=SMAX(JC)
  73. W(JC)=WMAX(JC)
  74. ENDIF
  75. *
  76. * CAS DE POURSUITE DE LA FISSURATION
  77. *
  78. ELSE IF(JC.GE.4.AND.JC.LE.6) THEN
  79. KC=JC-3
  80. SIGMA(KC)=SMAX(KC)
  81. W(KC)=WMAX(KC)
  82. ENDIF
  83. ENDDO
  84. *
  85. *
  86. DO IC=1,NCA
  87. JC=NN(IC)
  88. *
  89. * FISSURATION AVEC ISING=2
  90. *
  91. IF((JC.GE.1.AND.JC.LE.3).AND.ISING(JC).EQ.2) THEN
  92. SIGMA(JC)=SMAX(JC)
  93. W(JC)=WMAX(JC)
  94. ENDIF
  95.  
  96. ENDDO
  97. *
  98. *
  99. DO IC=1,NC
  100. NN(IC)=IC
  101. ENDDO
  102. *
  103. CALL OTTOEC(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  104. & XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
  105. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  106. IF(KERRE.NE.0) THEN
  107. PRINT *, ' OTTOVE - APRES OTTOEC KERRE=',KERRE
  108. RETURN
  109. ENDIF
  110. *
  111. DO IC=1,NC
  112. IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN
  113. PRINT *,'CRITERE DEPASSE NUMERO ',IC
  114. PRINT *,'CRITERE FC = ',FC(IC)
  115. PRINT *,'CRITERE FC2 = ',FC2(IC)
  116. KERRE=2
  117. RETURN
  118. ENDIF
  119. ENDDO
  120. *
  121. IF(IIMPI.EQ.42) THEN
  122. WRITE(IOIMP,78000) (FC(IC),IC=1,NC)
  123. 78000 FORMAT( 2X, ' OTTOVE - FC '/(4(1X,1PE12.5)/)/)
  124. ENDIF
  125. *
  126. RETURN
  127. END
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  

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