Télécharger ottoec.eso

Retour à la liste

Numérotation des lignes :

  1. C OTTOEC SOURCE CHAT 05/01/13 02:07:24 5004
  2. SUBROUTINE OTTOEC(NCA,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  3. & XLTR,XINVL,SBILI,FCRIT,FCRIT2,PENTE,PENTE2,LEBIL,ISING,
  4. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  5. C=========================================================================
  6. C
  7. C ENTREES :
  8. C SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,XLTR,XINVL,SBILI
  9. C
  10. C
  11. C SORTIES :
  12. C FCRIT
  13. C
  14. C==========================================================================
  15. C
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8(A-H,O-Z)
  18. -INC CCOPTIO
  19. C
  20. PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  21. PARAMETER (NC=4)
  22. C
  23. DIMENSION SIGMA(6),W(3),WMAX(3),BILIN(3),WREOUV(3),
  24. & WRUPT(3),XLTR(3),XINVL(3),SBILI(3)
  25. DIMENSION FCRIT(*),FCRIT2(*),NN(*),SMAX(*),XCOMP(*)
  26. DIMENSION LEBIL(*),ISING(*)
  27. DIMENSION PENTE(*),PENTE2(*)
  28. *
  29. DIMENSION DFF(6),DGG(6)
  30.  
  31. C
  32. C INITIALISATIONS
  33. C
  34. KERRE=0
  35. DO IC=1,NC
  36. FCRIT(IC)=-1.D4*PRECIZ
  37. FCRIT2(IC)=-1.D4*PRECIZ
  38. LEBIL(IC)=0
  39. ENDDO
  40. *
  41. *
  42. DO IC=1,NCA
  43. JC=NN(IC)
  44. *
  45. GO TO (1,1,1,4),JC
  46. *
  47. KERRE=99
  48. RETURN
  49. *
  50. 1 CONTINUE
  51. *-----------------
  52. *
  53. IF (XINVL(JC).NE.XZER) THEN
  54. *
  55. WREOUV(JC) = BTR*MIN(WMAX(JC),WRUPT(JC))
  56. PRECIW=PRECIE/XINVL(JC)
  57.  
  58. IF(IIMPI.EQ.42) THEN
  59. PRINT *,' '
  60. PRINT *,'OTTOEC - JC =',JC
  61. PRINT *,'OTTOEC - W =',W(JC)
  62. PRINT *,'OTTOEC - WMAX =',WMAX(JC)
  63. PRINT *,'OTTOEC - WREOUV =',WREOUV(JC)
  64. PRINT *,'OTTOEC - WRUPT =',WRUPT(JC)
  65. PRINT *,'OTTOEC - ISING =',ISING(JC)
  66. ENDIF
  67.  
  68. *
  69. *
  70. * cas ou le materiau n'est pas totalement casse
  71. * ---------------------------------------------
  72. *
  73. IF(WMAX(JC).LT.WRUPT(JC)) THEN
  74.  
  75. IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN
  76.  
  77. IF(WMAX(JC).EQ.0.D0.OR.BTR.EQ.UN) THEN
  78. *
  79. * le materiau vient d'atteindre la limite
  80. *
  81. CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,SBILI,W,
  82. & WMAX,SMAX,PENTE,JC)
  83. FCRIT(JC)=SIGMA(JC)-SMAX(JC)
  84.  
  85. ELSE
  86.  
  87. *
  88. *
  89. IF(IIMPI.EQ.42) THEN
  90. PRINT *,'CAS W=WREOUV DANS OTTOEC'
  91. ENDIF
  92.  
  93.  
  94. FCRIT(JC)=SIGMA(JC)
  95. IF(FCRIT(JC).GE.-PRECIZ) THEN
  96. *
  97. * ici on pourrait aussi tester que w > wreouv
  98. *
  99. PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
  100. LEBIL(JC)=1
  101. FCRIT(JC)= SIGMA(JC) -
  102. & PENTE(JC)*(W(JC)-WREOUV(JC))
  103. ENDIF
  104. ENDIF
  105. *
  106.  
  107. ELSE IF(W(JC).GT.WREOUV(JC)) THEN
  108.  
  109.  
  110. IF(W(JC)-WMAX(JC).GT.PRECIW) THEN
  111.  
  112. PRINT *,' OTTOEC - W > WMAX SELON ',JC
  113. PRINT *,'W(JC) =',W(JC)
  114. PRINT *,'WMAX(JC) =',WMAX(JC)
  115. KERRE=7
  116. RETURN
  117. *
  118. ELSE IF(ABS(W(JC)-WMAX(JC)).LT.PRECIW) THEN
  119. *
  120. *
  121. IF(IIMPI.EQ.42) THEN
  122. PRINT *,'CAS W=WMAX DANS OTTOEC'
  123. PRINT *,'ISING(JC) =',ISING(JC)
  124. ENDIF
  125. *
  126. CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,
  127. & SBILI,W,WMAX,SMAX,PENTE,JC)
  128. FCRIT(JC)=SIGMA(JC)-SMAX(JC)
  129.  
  130. IF(IIMPI.EQ.42) THEN
  131. PRINT *,'SIGMA=',SIGMA(JC)
  132. PRINT *,'SMAX =',SMAX(JC)
  133. PRINT *,'FCRIT=',FCRIT(JC)
  134. ENDIF
  135. *
  136. * CAS ISING=0 ON CALCULE 2 PENTES
  137. *
  138. PENTE2(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
  139. FCRIT2(JC) = SIGMA(JC)-PENTE2(JC)*(W(JC)-WREOUV(JC))
  140. *
  141. IF(ISING(JC).EQ.0) THEN
  142. LEBIL(JC)=2
  143. ISING(JC)=1
  144. *
  145. * CAS ISING=2 : PENTE POST-PIC
  146. *
  147. ELSE IF(ISING(JC).EQ.2) THEN
  148. LEBIL(JC)=0
  149. *
  150. * CAS ISING=3 : PENTE SECANTE
  151. *
  152. ELSE IF(ISING(JC).EQ.3) THEN
  153. LEBIL(JC)=1
  154. PENTE(JC)=PENTE2(JC)
  155. *
  156. IF(W(JC).LT.WMAX(JC)) THEN
  157. FCRIT(JC)= SIGMA(JC) -
  158. & PENTE(JC)*(W(JC)-WREOUV(JC))
  159. ENDIF
  160. ENDIF
  161.  
  162. ELSE IF(W(JC).LT.WMAX(JC)) THEN
  163.  
  164. PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
  165. FCRIT(JC)= SIGMA(JC) - PENTE(JC)*(W(JC)-WREOUV(JC))
  166. LEBIL(JC)=1
  167.  
  168. ENDIF
  169.  
  170. ELSE IF(W(JC).LT.WREOUV(JC)) THEN
  171. PRINT *,' OTTOEC - W < WREOUV SELON ',JC
  172. PRINT *,'W(JC) =',W(JC)
  173. PRINT *,'WREOUV(JC) =',WREOUV(JC)
  174. KERRE=7
  175. RETURN
  176. ENDIF
  177. *
  178. * cas ou le materiau est totalement casse
  179. * ---------------------------------------
  180. *
  181. ELSE IF(WMAX(JC).GE.WRUPT(JC)) THEN
  182.  
  183. FCRIT(JC)=SIGMA(JC)
  184.  
  185. IF(IIMPI.EQ.42) THEN
  186. PRINT *,'W(JC) =',W(JC)
  187. PRINT *,'WREOUV(JC) =',WREOUV(JC)
  188. ENDIF
  189. *
  190. IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN
  191.  
  192. IF(IIMPI.EQ.42) THEN
  193. PRINT *,' OTTOEC - ON EST A LA LIMITE '
  194. ENDIF
  195. *
  196. IF(FCRIT(JC).GE.-PRECIZ) THEN
  197. PENTE(JC)=0.D0
  198. LEBIL(JC)=1
  199. ENDIF
  200. *
  201. ELSE IF(W(JC).GT.WREOUV(JC)) THEN
  202. LEBIL(JC)=1
  203. PENTE(JC)=0.D0
  204. ENDIF
  205.  
  206. ENDIF
  207.  
  208. ENDIF
  209. GO TO 100
  210. *
  211. 4 CONTINUE
  212. *-----------------
  213. *
  214. CALL OTTOCP(SIGMA,FCR4,XLTR,DFF,DGG,H4,
  215. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  216.  
  217.  
  218. FCRIT(4) = FCR4
  219. * IF(IIMPI.EQ.42) THEN
  220. * WRITE(IOIMP,78000) FCR4
  221. *78000 FORMAT( 2X, ' OTTOEC - FCR4 '
  222. * & /(1(1X,1PE12.5)/)/)
  223. * ENDIF
  224. GO TO 100
  225. *
  226. 100 CONTINUE
  227. *
  228. ENDDO
  229. *
  230. IF(IIMPI.EQ.42) THEN
  231. WRITE(IOIMP,77000) (FCRIT(IC),IC=1,4)
  232. 77000 FORMAT( 2X, ' OTTOEC - FCRIT '/(4(1X,1PE12.5)/)/)
  233. WRITE(IOIMP,77001) (LEBIL(IC),IC=1,4)
  234. 77001 FORMAT( 2X, ' OTTOEC - LEBIL '/(4I4)/)
  235. WRITE(IOIMP,77003) (PENTE(IC),IC=1,4)
  236. 77003 FORMAT( 2X, ' OTTOEC - PENTE '/(4(1X,1PE12.5)/)/)
  237. ENDIF
  238. *
  239. RETURN
  240. END
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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