Télécharger ottoet.eso

Retour à la liste

Numérotation des lignes :

  1. C OTTOET SOURCE CHAT 05/01/13 02:07:28 5004
  2. SUBROUTINE OTTOET(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  3. & XLTR,XINVL,SBILI,PRECIE,PRECIZ,FC,FC2,LEBIL,NFISSU,
  4. & NVF,VF,FC0,PENTE,PENTE2,DX,DXV1,YOUN,NCA,MC,MM,
  5. & ISING,IFERM,IBRUP,IPLAS,XCOMP,XLAMC,DFF,DGG,KERRE)
  6. C
  7. C=========================================================================
  8. C
  9. C ENTREES :
  10. C SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,XLTR,XINVL,SBILI
  11. C
  12. C
  13. C SORTIES :
  14. C FC,LEBIL,NCA,MC,MM,FC0,PENTE
  15. C
  16. C==========================================================================
  17. C
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8(A-H,O-Z)
  20. -INC CCOPTIO
  21. C
  22. PARAMETER (XZER=0.D0)
  23. C
  24. DIMENSION SIGMA(6),W(3),WMAX(3),BILIN(3),WREOUV(3),
  25. & WRUPT(3),XLTR(3),XINVL(3),SBILI(3),XCOMP(*)
  26. DIMENSION PENTE(*),PENTE2(*),JFIS(3)
  27. DIMENSION FC(*),FC2(*),NN(*),MM(*),LEBIL(*),SMAX(*)
  28. DIMENSION VF(3,3),FC0(*)
  29. DIMENSION ISING(*),IFERM(*),IBRUP(*)
  30. DIMENSION DX(*),DXV1(*)
  31. *
  32. DIMENSION DFF(*),DGG(*)
  33.  
  34.  
  35. KERRE=0
  36. IPLAS=0
  37. CALL IANUL(ISING,NC)
  38. CALL IANUL(IFERM,NC)
  39. CALL IANUL(IBRUP,NC)
  40. *
  41. DO IC=1,NC
  42. NN(IC)=IC
  43. ENDDO
  44. *
  45. CALL OTTOEC(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  46. & XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
  47. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  48. IF(KERRE.NE.0) THEN
  49. PRINT *, ' OTTOET - APRES OTTOEC KERRE=',KERRE
  50. RETURN
  51. ENDIF
  52. *
  53. NCA=0
  54. MC=0
  55. LACOMP=0
  56. *
  57. *
  58. DO IC=1,3
  59. WREOUV(IC)=BTR*MIN(WMAX(IC),WRUPT(IC))
  60. *
  61. IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN
  62. * cas ou le critere est violé
  63. KERRE=2
  64. PRINT *,' OTTOET - CRITERE VIOLE ',IC
  65. RETURN
  66. ENDIF
  67. *
  68. * cas ou le critere n'est pas atteint
  69. * -----------------------------------
  70. *
  71. IF(FC(IC).LT.-PRECIZ.AND.FC2(IC).LT.-PRECIZ) THEN
  72. *
  73. * ---> sous-cas 1 : la direction n'a pas encore fissure
  74. *
  75. IF(XINVL(IC).EQ.XZER) THEN
  76.  
  77. MC=MC+1
  78. MM(MC)= IC
  79. *
  80. ELSE
  81. *
  82. * ---> sous-cas 2 : la direction a deja fissure
  83. *
  84. IF(LEBIL(IC).EQ.0) THEN
  85. * on est en compression
  86. *
  87. IF(BTR.LT.1.D0.AND.WMAX(IC).NE.XZER) THEN
  88. MC=MC+1
  89. MM(MC)= 9+IC
  90. LACOMP=1
  91. ELSE
  92. MC=MC+1
  93. MM(MC)= 3+IC
  94. LACOMP=1
  95. ENDIF
  96. ELSE
  97. KERRE=2
  98. PRINT *,' OTTOET - CAS IMPOSSIBLE ',IC
  99. * CAS IMPOSSIBLE
  100. RETURN
  101. ENDIF
  102. *
  103. ENDIF
  104.  
  105. ELSE
  106. *
  107. * cas ou le critere est atteint
  108. * -----------------------------
  109. *
  110. IF(XINVL(IC).EQ.XZER) THEN
  111. KERRE=2
  112. PRINT *,' OTTOET - XINVL EST NUL IC= ',IC
  113. RETURN
  114. ENDIF
  115. *
  116. PRECIW=PRECIE/XINVL(IC)
  117. NCA=NCA+1
  118. NN(NCA)=IC
  119. *
  120. * ---> sous-cas 1 : le materiau n'est pas totalement casse
  121. * ---------------------------------------------------
  122. *
  123. IF(WMAX(IC).LT.WRUPT(IC)) THEN
  124. *
  125. IF(ABS(W(IC)-WREOUV(IC)).LT.PRECIW) THEN
  126. *
  127. IF(WMAX(IC).EQ.0.D0.OR.BTR.EQ.1.D0) THEN
  128. *
  129. * le materiau vient d'atteindre la limite
  130. *
  131. MC=MC+1
  132. MM(MC)= 6+IC
  133. LACOMP=1
  134. IBRUP(IC)=1
  135.  
  136. ELSE
  137. *
  138. * on est pile sur le critere sigma=0 (==> IFERM=1)
  139. * et LEBIL vaut 1
  140. *
  141. IF(LEBIL(IC).NE.1) THEN
  142. KERRE=2
  143. PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC
  144. RETURN
  145. ENDIF
  146. *
  147. MC=MC+1
  148. MM(MC)= 3+IC
  149. LACOMP=1
  150. IFERM(IC)=1
  151. ENDIF
  152.  
  153. ELSE IF(W(IC).GT.WREOUV(IC)) THEN
  154. IPLAS=1
  155. *
  156. IF(ABS(W(IC)-WMAX(IC)).LT.PRECIW) THEN
  157. *
  158. * LEBIL vaut 2
  159. *
  160. IF(LEBIL(IC).NE.2) THEN
  161. KERRE=2
  162. PRINT *,' OTTOET - LEBIL NEG 2 SELON ',IC
  163. RETURN
  164. ENDIF
  165. *
  166. * d'abord les 2
  167. *
  168. IF(FC(IC).GT.-PRECIZ.AND.
  169. & FC2(IC).GT.-PRECIZ) THEN
  170. *
  171. MC=MC+1
  172. MM(MC)= 6+IC
  173. MC=MC+1
  174. MM(MC)= 12+IC
  175. *
  176. * sinon seul le secant
  177. *
  178. ELSE IF(FC(IC).LT.-PRECIZ.AND.
  179. & FC2(IC).GT.-PRECIZ) THEN
  180. *
  181. * on remet lebil a 1
  182. *
  183. LEBIL(IC)=1
  184. FC(IC)=FC2(IC)
  185. PENTE(IC)=PENTE2(IC)
  186. MC=MC+1
  187. MM(MC)= 3+IC
  188. MC=MC+1
  189. MM(MC)= 12+IC
  190. *
  191. ELSE
  192. KERRE=2
  193. PRINT *,' OTTOET - CAS PAS ',
  194. & 'POSSIBLE SELON ',IC
  195. RETURN
  196. ENDIF
  197. *
  198. *
  199. ELSE
  200. *
  201. * on est sur le secant ,
  202. * et LEBIL vaut 1
  203. *
  204. IF(LEBIL(IC).NE.1) THEN
  205. KERRE=2
  206. PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC
  207. RETURN
  208. ENDIF
  209. *
  210. MC=MC+1
  211. MM(MC)= 3+IC
  212. MC=MC+1
  213. MM(MC)= 12+IC
  214. ENDIF
  215. *
  216. ELSE
  217. *
  218. * W < WREOUV : CAS IMPOSSIBLE
  219. *
  220. KERRE=2
  221. PRINT *,' OTTOET - W < WREOUV IC= ',IC
  222. PRINT *,'W(IC)=',W(IC)
  223. PRINT *,'WMAX(IC)=',WMAX(IC)
  224. PRINT *,'WREOUV(IC)=',WREOUV(IC)
  225. PRINT *,'WRUPT(IC)=',WRUPT(IC)
  226.  
  227.  
  228. RETURN
  229. ENDIF
  230. *
  231. * ---> sous-cas 2 : le materiau est totalement casse
  232. * ---------------------------------------------
  233. *
  234. ELSE IF(WMAX(IC).GE.WRUPT(IC)) THEN
  235. *
  236.  
  237. IF(W(IC)-WREOUV(IC).LT.-PRECIW) THEN
  238.  
  239. *
  240. * W < WREOUV : CAS IMPOSSIBLE
  241. *
  242. KERRE=2
  243. PRINT *,' OTTOET - W < WREOUV IC= ',IC
  244. PRINT *,'W(IC)=',W(IC)
  245. PRINT *,'WMAX(IC)=',WMAX(IC)
  246. PRINT *,'WREOUV(IC)=',WREOUV(IC)
  247. PRINT *,'WRUPT(IC)=',WRUPT(IC)
  248. RETURN
  249.  
  250.  
  251. ELSE
  252. *
  253. * on est en ouverture (IPLAS=1)
  254. * ou bien on est pile sur la limite sigma=0 (IPLAS=0)
  255. * LEBIL vaut 1 dans les 2 cas
  256. *
  257. IF(LEBIL(IC).NE.1) THEN
  258. KERRE=2
  259. PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC
  260. RETURN
  261. ENDIF
  262. *
  263. IF(W(IC)-WREOUV(IC).GT.PRECIW) THEN
  264. IPLAS=1
  265. MC=MC+1
  266. MM(MC)= 12+IC
  267. ELSE
  268. IFERM(IC)=1
  269. LACOMP=1
  270. ENDIF
  271. *
  272. ENDIF
  273. ENDIF
  274.  
  275. ENDIF
  276.  
  277. ENDDO
  278. *
  279. *
  280. *
  281. * CAS NUMERO 4
  282. *
  283. IF(FC(4).GT.PRECIZ) THEN
  284. KERRE=2
  285. PRINT *,' OTTOET - CRITERE VIOLE N0 4 '
  286. RETURN
  287. ENDIF
  288. *
  289. *
  290.  
  291. IF(FC(4).LT.-PRECIZ) THEN
  292. LACOMP=1
  293. ELSE
  294. NCA=NCA+1
  295. NN(NCA)=4
  296. LACOMP=0
  297. IFERM(4)=1
  298. ENDIF
  299. *
  300.  
  301. * MLR 9/7/99
  302. * ON MET 16 SYSTEMATIQUEMENT
  303. *
  304. *
  305. ***** IF(LACOMP.EQ.1) THEN
  306. ***** MC=MC+1
  307. ***** MM(MC)=16
  308. ***** ENDIF
  309. *
  310.  
  311. MC=MC+1
  312. MM(MC)=16
  313.  
  314. *
  315. *
  316. * TEST SUR MC
  317. *
  318. IF(MC.EQ.0) THEN
  319. KERRE=2
  320. PRINT *,' OTTOET - MC EST NUL '
  321. RETURN
  322. ENDIF
  323. *
  324. * APPEL A OTTOCE
  325. *
  326. CALL OTTOCE(MC,MM,SIGMA,DX,DXV1,W,WMAX,SMAX,WRUPT,
  327. & XLTR,XINVL,BTR,NFISSU,NVF,FC0,VF,YOUN,
  328. & PRECIZ,JFIS,XCOMP,XLAMC,DFF,DGG,KERRE)
  329. IF(KERRE.NE.0) THEN
  330. PRINT *, ' OTTOET - APRES OTTOCE KERRE=',KERRE
  331. RETURN
  332. ENDIF
  333. *
  334. * TEST DE L'ETAT INITIAL
  335. *
  336. DO IC=1,MC
  337. JC=MM(IC)
  338. IF(FC0(JC).GT.PRECIZ)THEN
  339. PRINT *,'OTTOET - ETAT INITIAL INADMISSIBLE'
  340. KERRE=2
  341. RETURN
  342. ENDIF
  343. ENDDO
  344. *
  345. IF(IIMPI.EQ.42) THEN
  346. WRITE(IOIMP,77000) (FC(IC),IC=1,NC)
  347. 77000 FORMAT( 2X, ' OTTOET - FC '/(4(1X,1PE12.5)/)/)
  348. WRITE(IOIMP,77001) (LEBIL(IC),IC=1,NC)
  349. 77001 FORMAT( 2X, ' OTTOET - LEBIL '/(7I4)/)
  350. WRITE(IOIMP,77002) NCA,MC
  351. 77002 FORMAT( 2X, ' OTTOET - NCA=',I3,2X,'MC=',I3/)
  352. WRITE(IOIMP,77003) (NN(IC),IC=1,NCA)
  353. 77003 FORMAT( 2X, ' OTTOET - NN '/16(1X,I3)/)
  354. WRITE(IOIMP,77004) (MM(IC),IC=1,MC)
  355. 77004 FORMAT( 2X, ' OTTOET - MM '/16(1X,I3)/)
  356. ENDIF
  357. *
  358. RETURN
  359. END
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  

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