Télécharger ottocr.eso

Retour à la liste

Numérotation des lignes :

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

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