Télécharger ottocr.eso

Retour à la liste

Numérotation des lignes :

ottocr
  1. C OTTOCR SOURCE AM 11/05/03 21:17:51 6955
  2. C responsable MILLARD
  3. SUBROUTINE OTTOCR(NCA,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  4. & XLTR,XINVL,SBILI,FCRIT,PENTE,LEBIL,
  5. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  6. C=========================================================================
  7. C
  8. C ENTREES :
  9. C SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,XLTR,XINVL,SBILI
  10. C CETTE FOIS, LEBIL EST EN ENTREE
  11. C
  12. C SORTIES :
  13. C FCRIT,PENTE
  14. C
  15. C==========================================================================
  16. C
  17. IMPLICIT INTEGER(I-N)
  18. IMPLICIT REAL*8(A-H,O-Z)
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. C
  23. PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  24. PARAMETER (NC=4)
  25. C
  26. DIMENSION SIGMA(6),W(3),WMAX(3),BILIN(3),WREOUV(3),
  27. & WRUPT(3),XLTR(3),XINVL(3),SBILI(3),FJ(3),XCOMP(*)
  28. DIMENSION FCRIT(*),NN(*),SMAX(*)
  29. DIMENSION LEBIL(*)
  30. DIMENSION PENTE(*)
  31. *
  32. DIMENSION DFF(6),DGG(6)
  33.  
  34. C
  35. C INITIALISATIONS
  36. C
  37. KERRE=0
  38. DO IC=1,NC
  39. FCRIT(IC)=-1.D4*PRECIZ
  40. ENDDO
  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. IF (XINVL(JC).NE.XZER) THEN
  53. *
  54. WREOUV(JC) = BTR*MIN(WMAX(JC),WRUPT(JC))
  55. PRECIW=PRECIE/XINVL(JC)
  56.  
  57. IF(IIMPI.EQ.42) THEN
  58. PRINT *,' '
  59. PRINT *,'OTTOCR - JC =',JC
  60. PRINT *,'OTTOCR - W =',W(JC)
  61. PRINT *,'OTTOCR - WMAX =',WMAX(JC)
  62. PRINT *,'OTTOCR - WREOUV =',WREOUV(JC)
  63. PRINT *,'OTTOCR - WRUPT =',WRUPT(JC)
  64. PRINT *,'OTTOCR - SMAX =',SMAX(JC)
  65. PRINT *,'OTTOCR - LEBIL =',LEBIL(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. **************************************************
  86. **** AM AMELIORATION POUR BRUIT NUMERIQUE
  87. **************************************************
  88.  
  89. ELSE IF(WMAX(JC).NE.0.D0.AND.
  90. & ABS(W(JC)-WMAX(JC)).LT.PRECIW) THEN
  91. *
  92. * on a deja atteint la limite, mais on a w = wmax tres petits
  93. * on reprend la sequence qui est plus loin dans le cas
  94. * ou W > WREOUV
  95. *
  96. * CAS A L'INTERSECTION SECANTE - POST PIC
  97. *
  98. IF(LEBIL(JC).EQ.0) THEN
  99. CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,
  100. & SBILI,W,WMAX,SMAX,PENTE,JC)
  101. FCRIT(JC)=SIGMA(JC)-SMAX(JC)
  102.  
  103. ELSE IF(LEBIL(JC).EQ.1) THEN
  104. PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
  105. FCRIT(JC)= SIGMA(JC) -
  106. & PENTE(JC)*(W(JC)-WREOUV(JC))
  107. *
  108. ELSE IF(LEBIL(JC).EQ.2) THEN
  109. PRINT *,'OTTOCR CAS IMPOSSIBLE SELON ',JC
  110. KERRE=7
  111. RETURN
  112. ENDIF
  113.  
  114. *************************************************************
  115. **** AM fin de l'amelioration
  116. *************************************************************
  117.  
  118. ELSE
  119.  
  120. *
  121. * CAS A L'INTERSECTION SIGMA=0 - SECANTE
  122. *
  123. IF(LEBIL(JC).EQ.0) THEN
  124. FCRIT(JC)=SIGMA(JC)
  125. IF(FCRIT(JC).GE.-PRECIZ) THEN
  126. PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
  127. ENDIF
  128. *
  129. ELSE IF(LEBIL(JC).EQ.1) THEN
  130. PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
  131. FCRIT(JC)= SIGMA(JC) -
  132. & PENTE(JC)*(W(JC)-WREOUV(JC))
  133. *
  134. ELSE IF(LEBIL(JC).EQ.2) THEN
  135. PRINT *,'OTTOCR CAS IMPOSSIBLE SELON ',JC
  136. KERRE=7
  137. RETURN
  138. ENDIF
  139. ENDIF
  140. *
  141. ELSE IF(W(JC).GT.WREOUV(JC)) THEN
  142.  
  143.  
  144. IF(W(JC)-WMAX(JC).GT.PRECIW) THEN
  145.  
  146. PRINT *,' OTTOCR - W > WMAX SELON ',JC
  147. PRINT *,'W(JC) =',W(JC)
  148. PRINT *,'WMAX(JC) =',WMAX(JC)
  149. KERRE=7
  150. RETURN
  151.  
  152. *
  153.  
  154. ELSE IF(ABS(W(JC)-WMAX(JC)).LT.PRECIW) THEN
  155. *
  156. * CAS A L'INTERSECTION SECANTE - POST PIC
  157. *
  158. IF(LEBIL(JC).EQ.0) THEN
  159. CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,
  160. & SBILI,W,WMAX,SMAX,PENTE,JC)
  161. FCRIT(JC)=SIGMA(JC)-SMAX(JC)
  162.  
  163. ELSE IF(LEBIL(JC).EQ.1) THEN
  164. PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
  165. FCRIT(JC)= SIGMA(JC) -
  166. & PENTE(JC)*(W(JC)-WREOUV(JC))
  167. *
  168. ELSE IF(LEBIL(JC).EQ.2) THEN
  169. PRINT *,'OTTOCR CAS IMPOSSIBLE SELON ',JC
  170. KERRE=7
  171. RETURN
  172. ENDIF
  173. *
  174.  
  175. ELSE IF(W(JC).LT.WMAX(JC)) THEN
  176.  
  177. PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
  178. FCRIT(JC)= SIGMA(JC) - PENTE(JC)*(W(JC)-WREOUV(JC))
  179.  
  180. ENDIF
  181.  
  182. ELSE IF(W(JC).LT.WREOUV(JC)) THEN
  183. PRINT *,' OTTOCR - W < WREOUV SELON ',JC
  184. PRINT *,'W(JC) =',W(JC)
  185. PRINT *,'WREOUV(JC) =',WREOUV(JC)
  186. KERRE=7
  187. RETURN
  188. ENDIF
  189. *
  190. * cas ou le materiau est totalement casse
  191. * ---------------------------------------
  192. *
  193. ELSE IF(WMAX(JC).GE.WRUPT(JC)) THEN
  194.  
  195. FCRIT(JC)=SIGMA(JC)
  196.  
  197. IF(IIMPI.EQ.42) THEN
  198. PRINT *,'W(JC) =',W(JC)
  199. PRINT *,'WREOUV(JC) =',WREOUV(JC)
  200. ENDIF
  201. *
  202. IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN
  203. *
  204. IF(IIMPI.EQ.42) THEN
  205. PRINT *,' OTTOCR - ON EST A LA LIMITE '
  206. ENDIF
  207. *
  208. IF(FCRIT(JC).GE.-PRECIZ) THEN
  209. PENTE(JC)=0.D0
  210. ENDIF
  211. ELSE IF(W(JC).GT.WREOUV(JC)) THEN
  212. PENTE(JC)=0.D0
  213. ENDIF
  214.  
  215. ENDIF
  216.  
  217. ENDIF
  218. GO TO 100
  219. *
  220. 4 CONTINUE
  221. *
  222. CALL OTTOCP(SIGMA,FCR4,XLTR,DFF,DGG,H4,
  223. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  224.  
  225.  
  226. FCRIT(4) = FCR4
  227. GO TO 100
  228. *
  229. 100 CONTINUE
  230. *
  231. ENDDO
  232. *
  233. IF(IIMPI.EQ.42) THEN
  234. WRITE(IOIMP,77000) (FCRIT(IC),IC=1,4)
  235. 77000 FORMAT( 2X, ' OTTOCR - FCRIT '/(4(1X,1PE12.5)/)/)
  236. WRITE(IOIMP,77003) (PENTE(IC),IC=1,4)
  237. 77003 FORMAT( 2X, ' OTTOCR - PENTE '/(4(1X,1PE12.5)/)/)
  238. ENDIF
  239. *
  240. RETURN
  241. END
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  

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