Télécharger ottoet.eso

Retour à la liste

Numérotation des lignes :

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

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