Télécharger crack.eso

Retour à la liste

Numérotation des lignes :

  1. C CRACK SOURCE CHAT 05/01/12 22:27:45 5004
  2. SUBROUTINE CRACK(SIGMAT,SIGEL,DSIGP,R1,R2,R3,TETAQ,ITRAC,ITENS,
  3. .ITENRZ,ITENTE,ITETA,IRZ,SIGMA,DSIGMA,YUNG,XNU,
  4. .ALFAD2,DPELA2,PENTE2,IBAB,ICTD,KASTR,
  5. .PREC,RFSG,RFEP,RFPR,KERRE)
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. -INC CCOPTIO
  10. C
  11. DIMENSION SIGEL(*),DSIGP(*)
  12. DIMENSION SIGMAT(6),WW1(3),SIGMA(6),DSIGP0(6)
  13. DIMENSION SIGTP(6),SIG0P(6),DSIGPP(6),DSIGMA(6),SIGEL0(6)
  14. C
  15. C INITIALISATION DES VARIABLES
  16. C
  17. CRIT= 0.D0
  18. GAMCIS=0.D0
  19. F1ST=0.D0
  20. F2ST=0.D0
  21. C
  22. C SI ON N A PAS LE DROIT D ECOULER SELON LE CRITERE DE LA TRACTION
  23. C
  24. IF(KASTR.NE.2) GO TO 99
  25. DO 199 I=1,6
  26. SIGMA(I)=SIGEL(I)
  27. DSIGMA(I)=DSIGP(I)
  28. 199 CONTINUE
  29. ICTD=1
  30. GO TO 333
  31. C
  32. C INITIALISATION
  33. C
  34. 99 R10=R1
  35. R20=R2
  36. R30=R3
  37. TETAQ0=TETAQ
  38. ITRAC0=ITRAC
  39. ITETA0=ITETA
  40. IRZ0=IRZ
  41. DO 100 I=1,6
  42. SIGEL0(I)=SIGEL(I)
  43. DSIGP0(I)=DSIGP(I)
  44. 100 CONTINUE
  45. UNIT=0.01745329252D0
  46. LUNE=1
  47. ICONCA=0
  48. ITER=0
  49. ICTD=0
  50. ZER=0.D0
  51. C
  52. 96 IND=0
  53. IND1=0
  54. IND2=0
  55. IND3=0
  56. JTRAC=ITRAC
  57. ITENS=0
  58. ITENRZ=0
  59. ITENTE=0
  60. SIMER=0.D0
  61. C
  62. C ROTATION DES AXES
  63. C
  64. 24 IF(ITER.LE.12) GO TO 48
  65. WRITE(IOIMP,1002) ITER
  66. KERRE=640
  67. RETURN
  68. C
  69. 48 ITER=ITER+1
  70. IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6)
  71. IF(IIMPI.EQ.9) WRITE(IOIMP,7006) (DSIGP(I),I=1,6)
  72. IF(IIMPI.EQ.9)
  73. . WRITE(IOIMP,7000) ITRAC,ITENRZ,ITENTE,ITETA,IRZ,ITER
  74. C
  75. IF(ITRAC.GT.0) GO TO 1
  76. WW1(1)=SIGEL(1)
  77. WW1(2)=SIGEL(2)
  78. WW1(3)=SIGEL(4)
  79. CALL DIAGOD(WW1)
  80. TETAQ=WW1(3)
  81. C
  82. 1 ANRUP=TETAQ*UNIT
  83. CO=COS(ANRUP)
  84. SII=SIN(ANRUP)
  85. CC=CO*CO
  86. SS=SII*SII
  87. CS=CO*SII
  88. C
  89. IF(ITRAC.GT.0) WW1(1)=ROTA(SIGEL,CC,SS,CS,1)
  90. IF(ITRAC.GT.0) WW1(2)=ROTA(SIGEL,CC,SS,CS,2)
  91. SIG0P(1)=WW1(1)
  92. SIG0P(2)=WW1(2)
  93. SIG0P(3)=SIGEL(3)
  94. SIG0P(4)=0.D0
  95. IF(ITRAC.GT.0) SIG0P(4)=ROTA(SIGEL,CC,SS,CS,3)
  96. SIG0P(5)=0.D0
  97. SIG0P(6)=0.D0
  98. C
  99. DSIGPP(1)=ROTA(DSIGP,CC,SS,CS,1)
  100. DSIGPP(2)=ROTA(DSIGP,CC,SS,CS,2)
  101. DSIGPP(3)=DSIGP(3)
  102. DSIGPP(4)=ROTA(DSIGP,CC,SS,CS,3)
  103. DSIGPP(5)=0.D0
  104. DSIGPP(6)=0.D0
  105. C
  106. IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 70
  107. DO 2 I=1,6
  108. SIGMA(I)=SIG0P(I)
  109. 2 CONTINUE
  110. IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6)
  111. C
  112. 70 DO 3 I=1,6
  113. SIGTP(I)=SIG0P(I)+DSIGPP(I)
  114. SIGMAT(I)=SIGEL(I)+DSIGP(I)
  115. 3 CONTINUE
  116. C
  117. IF(IIMPI.EQ.9) WRITE(IOIMP,7003) (SIG0P(I),I=1,6)
  118. IF(IIMPI.EQ.9) WRITE(IOIMP,7004) (DSIGPP(I),I=1,6)
  119. IF(IIMPI.EQ.9) WRITE(IOIMP,7005) (SIGTP(I),I=1,6)
  120. C
  121. CRIT1=SIGTP(1)-R1
  122. CRIT2=SIGTP(2)-R2
  123. CRIT3=SIGTP(3)-R3
  124. C
  125. IF(CRIT1.LE.0.D0.AND.CRIT2.LE.0.D0.AND.CRIT3.LE.0.D0) GO TO 4
  126. C
  127. UNMU=XNU/(1.D0-XNU)
  128. IF(CRIT1.GT.0.D0.AND.ITETA.NE.1.AND.IRZ.NE.2) IND1=1
  129. IF(CRIT2.GT.0.D0.AND.ITETA.NE.1.AND.IRZ.NE.1) IND2=2
  130. IF(CRIT3.GT.0.D0.AND.ITETA.NE.2) IND3=4
  131. IND=IND1+IND2+IND3
  132. IF(IIMPI.EQ.9) WRITE(IOIMP,7011) IND,IND1,IND2,IND3
  133. GO TO(11,12,14,13,15,16,17),IND
  134. WRITE(IOIMP,1000)IND
  135. KERRE=640
  136. RETURN
  137. C
  138. C***********************************************************************
  139. C*************************** CAS D UNE SEULE FISSURE *******************
  140. C***********************************************************************
  141. C
  142. C FISSURE DANS LA DIRECTION (R)
  143. C
  144. 11 DSIGPP(1)=-SIG0P(1)
  145. DSIGPP(4)=-SIG0P(4)
  146. DSIGPP(6)=-SIG0P(6)
  147. DSIGPP(2)=DSIGPP(2)-SIGTP(1)*UNMU
  148. DSIGPP(3)=DSIGPP(3)-SIGTP(1)*UNMU
  149. SIMER=SIG0P(1)*UNMU
  150. R1=0.D0
  151. ITENRZ=1
  152. ITRAC=1
  153. IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5
  154. SIGMA(1)=0.D0
  155. SIGMA(2)=SIGMA(2)-SIMER
  156. SIGMA(3)=SIGMA(3)-SIMER
  157. SIGMA(4)=0.D0
  158. SIGMA(6)=0.D0
  159. GO TO 5
  160. C
  161. C FISSURE DANS LA DIRECTION (Z)
  162. C
  163. 12 DSIGPP(2)=-SIG0P(2)
  164. DSIGPP(4)=-SIG0P(4)
  165. DSIGPP(5)=-SIG0P(5)
  166. DSIGPP(1)=DSIGPP(1)-SIGTP(2)*UNMU
  167. DSIGPP(3)=DSIGPP(3)-SIGTP(2)*UNMU
  168. SIMER=SIG0P(2)*UNMU
  169. R2=0.D0
  170. ITENRZ=1
  171. ITRAC=1
  172. IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5
  173. SIGMA(1)=SIGMA(1)-SIMER
  174. SIGMA(2)=0.D0
  175. SIGMA(3)=SIGMA(3)-SIMER
  176. SIGMA(4)=0.D0
  177. SIGMA(5)=0.D0
  178. GO TO 5
  179. C
  180. C FISSURE DANS LA DIRECTION (@)
  181. C
  182. 13 DSIGPP(3)=-SIG0P(3)
  183. DSIGPP(5)=-SIG0P(5)
  184. DSIGPP(6)=-SIG0P(6)
  185. DSIGPP(1)=DSIGPP(1)-SIGTP(3)*UNMU
  186. DSIGPP(2)=DSIGPP(2)-SIGTP(3)*UNMU
  187. SIMER=SIG0P(3)*UNMU
  188. R3=0.D0
  189. ITENTE=1
  190. IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5
  191. SIGMA(1)=SIGMA(1)-SIMER
  192. SIGMA(2)=SIGMA(2)-SIMER
  193. SIGMA(3)=0.D0
  194. SIGMA(5)=0.D0
  195. SIGMA(6)=0.D0
  196. GO TO 5
  197. C
  198. C***********************************************************************
  199. C*************************** CAS DE DEUX FISSURES **********************
  200. C***********************************************************************
  201. C
  202. C DEUX FISSURES DANS LE PLAN (RZ)
  203. C
  204. 14 DSIGPP(1)=-SIG0P(1)
  205. DSIGPP(2)=-SIG0P(2)
  206. DSIGPP(3)=DSIGPP(3)-XNU*(SIGTP(1)+SIGTP(2))
  207. SIMER=XNU*(SIG0P(1)+SIG0P(2))
  208. R1=0.D0
  209. R2=0.D0
  210. ITENRZ=2
  211. ITRAC=1
  212. IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6
  213. SIGMA(1)=0.D0
  214. SIGMA(2)=0.D0
  215. SIGMA(3)=SIGMA(3)-SIMER
  216. SIGMA(4)=0.D0
  217. SIGMA(5)=0.D0
  218. SIGMA(6)=0.D0
  219. GO TO 6
  220. C
  221. C DEUX FISSURES DANS LE PLAN (R@)
  222. C
  223. 15 DSIGPP(1)=-SIG0P(1)
  224. DSIGPP(3)=-SIG0P(3)
  225. DSIGPP(2)=DSIGPP(2)-XNU*(SIGTP(1)+SIGTP(3))
  226. SIMER=XNU*(SIG0P(1)+SIG0P(3))
  227. R1=0.D0
  228. R3=0.D0
  229. ITENRZ=1
  230. ITENTE=1
  231. ITRAC=1
  232. IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6
  233. SIGMA(1)=0.D0
  234. SIGMA(2)=SIGMA(2)-SIMER
  235. SIGMA(3)=0.D0
  236. SIGMA(4)=0.D0
  237. SIGMA(5)=0.D0
  238. SIGMA(6)=0.D0
  239. GO TO 6
  240. C
  241. C DEUX FISSURES DANS LE PLAN (Z@)
  242. C
  243. 16 DSIGPP(2)=-SIG0P(2)
  244. DSIGPP(3)=-SIG0P(3)
  245. DSIGPP(1)=DSIGPP(1)-XNU*(SIGTP(2)+SIGTP(3))
  246. SIMER=XNU*(SIG0P(2)+SIG0P(3))
  247. R2=0.D0
  248. R3=0.D0
  249. ITENRZ=1
  250. ITENTE=1
  251. ITRAC=1
  252. IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6
  253. SIGMA(1)=SIGMA(1)-SIMER
  254. SIGMA(2)=0.D0
  255. SIGMA(3)=0.D0
  256. SIGMA(4)=0.D0
  257. SIGMA(5)=0.D0
  258. SIGMA(6)=0.D0
  259. GO TO 6
  260. C
  261. C***********************************************************************
  262. C***************************** CAS DE TROIS FISSURES *******************
  263. C***********************************************************************
  264. C
  265. 17 DSIGPP(1)=-SIG0P(1)
  266. DSIGPP(2)=-SIG0P(2)
  267. DSIGPP(3)=-SIG0P(3)
  268. R1=0.D0
  269. R2=0.D0
  270. R3=0.D0
  271. ITENRZ=2
  272. ITENTE=1
  273. ITRAC=1
  274. IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6
  275. DO 8 I=1,6
  276. SIGMA(I)=0.D0
  277. 8 CONTINUE
  278. C
  279. 6 DSIGPP(4)=-SIG0P(4)
  280. DSIGPP(5)=-SIG0P(5)
  281. DSIGPP(6)=-SIG0P(6)
  282. C
  283. 5 DO 7 I=1,6
  284. SIGTP(I)=SIG0P(I)+DSIGPP(I)
  285. 7 CONTINUE
  286. C
  287. IF(IIMPI.EQ.9) WRITE(IOIMP,7005) (SIGTP(I),I=1,6)
  288. C
  289. C LE RETOUR DANS LES AXES
  290. C
  291. WW1(1)=SIGTP(1)
  292. WW1(2)=SIGTP(2)
  293. WW1(3)=SIGTP(4)
  294. C
  295. CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  296. C
  297. SIGEL(3)=SIGTP(3)
  298. SIGEL(5)=0.D0
  299. SIGEL(6)=0.D0
  300. C
  301. IF(ITENRZ.EQ.0.AND.JTRAC.EQ.0) TETAQ=0.D0
  302. IF(IIMPI.EQ.9)
  303. . WRITE(IOIMP,7000) ITRAC,ITENRZ,ITENTE,ITETA,IRZ,ITER
  304. C
  305. IF(ITETA.EQ.3.AND.IRZ.EQ.1) ITETA=5
  306. IF(ITETA.EQ.3.AND.IRZ.EQ.2) ITETA=6
  307. IF(IIMPI.EQ.9) WRITE(IOIMP,7012) ITETA
  308. GO TO(21,22,23,33,25,26,23),ITETA
  309. WRITE(IOIMP,1001)ITETA
  310. KERRE=640
  311. RETURN
  312. C
  313. C***********************************************************************
  314. C*************************** FISSURATION EN (@) PUIS EN (RZ) ***********
  315. C***********************************************************************
  316. C
  317. 21 IF(ITRAC.GT.0) GO TO 18
  318. WW1(1)=SIGEL(1)
  319. WW1(2)=SIGEL(2)
  320. WW1(3)=SIGEL(4)
  321. CALL DIAGOD(WW1)
  322. F1ST=WW1(1)
  323. F2ST=WW1(2)
  324. 18 IF(ITRAC.GT.0) F1ST=ROTA(SIGEL,CC,SS,CS,1)
  325. IF(ITRAC.GT.0) F2ST=ROTA(SIGEL,CC,SS,CS,2)
  326. CRIT1=F1ST-R1
  327. CRIT2=F2ST-R2
  328. IF(CRIT1.LE.0.D0.AND.CRIT2.LE.0.D0) GO TO 23
  329. SIG0P(1)=SIG0P(1)-SIMER
  330. SIG0P(2)=SIG0P(2)-SIMER
  331. DSIGPP(1)=DSIGPP(1)+SIMER
  332. DSIGPP(2)=DSIGPP(2)+SIMER
  333. C
  334. DO 19 I=1,6
  335. SIGMAT(I)=SIG0P(I)
  336. DSIGMA(I)=DSIGPP(I)
  337. 19 CONTINUE
  338. C
  339. C RETOUR DANS LES AXES
  340. C
  341. WW1(1)=SIGMAT(1)
  342. WW1(2)=SIGMAT(2)
  343. WW1(3)=SIGMAT(4)
  344. C
  345. CALL RETOUR(WW1,SIGMAT,CC,SS,CS,LUNE)
  346. C
  347. WW1(1)=DSIGMA(1)
  348. WW1(2)=DSIGMA(2)
  349. WW1(3)=DSIGMA(4)
  350. C
  351. CALL RETOUR(WW1,DSIGMA,CC,SS,CS,LUNE)
  352. C
  353. CALL GAMTR(SIGMAT,DSIGMA,F1ST,F2ST,R1,R2,CC,SS,CS,ITRAC,IRZ,
  354. . GAMMA,PREC,RFSG,RFEP,RFPR,KERRE)
  355. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  356. IF(GAMMA.GE.1.D0) GO TO 23
  357. IF(GAMMA.LT.0.D0) GAMMA=0.D0
  358. C
  359. C CORRECTION DES INCREMENTS DE CONTRAINTES
  360. C
  361. IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6)
  362. DSIGPP(1)=DSIGPP(1)*GAMMA
  363. DSIGPP(2)=DSIGPP(2)*GAMMA
  364. DSIGPP(4)=DSIGPP(4)*GAMMA
  365. DO 20 I=1,6
  366. SIGEL(I)=SIG0P(I)+DSIGPP(I)
  367. DSIGP(I)=DSIGP(I)*(1.D0-GAMMA)
  368. 20 CONTINUE
  369. C
  370. C RETOUR DANS LES AXES
  371. C
  372. WW1(1)=SIGEL(1)
  373. WW1(2)=SIGEL(2)
  374. WW1(3)=SIGEL(4)
  375. C
  376. CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  377. C
  378. ITETA=ITETA+IRZ+3
  379. IND1=0
  380. IND2=0
  381. IND3=0
  382. IND=0
  383. SIMER=0.D0
  384. GO TO 24
  385. C
  386. C***********************************************************************
  387. C************************* FISSURATION EN (RZ) PUIS EN (@) *************
  388. C***********************************************************************
  389. C
  390. 22 GO TO(31,32,33),IND
  391. WRITE(IOIMP,1000)IND
  392. KERRE=640
  393. RETURN
  394. C
  395. C****************** FISSURATION EN (R) PUIS EN (Z) ET (@) **************
  396. C
  397. 31 WW1(2)=ROTA(SIGEL,CC,SS,CS,2)
  398. CRIT=WW1(2)-R2
  399. IF(CRIT.LE.0.D0) GO TO 33
  400. C
  401. CRIT3=SIGEL(3)-R3
  402. IF(CRIT3.LE.0.D0) GO TO 205
  403. C
  404. SIG0P(2)=SIG0P(2)-SIMER
  405. SIG0P(3)=SIG0P(3)-SIMER
  406. DSIGPP(2)=DSIGPP(2)+SIMER
  407. DSIGPP(3)=DSIGPP(3)+SIMER
  408. C
  409. IF(DSIGPP(2).EQ.0.D0) GO TO 28
  410. GAMM1=(R2-SIG0P(2))/DSIGPP(2)
  411. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM1
  412. IF(GAMM1.LT.0.D0) GAMM1=0.D0
  413. IF(GAMM1.GE.0.D0.AND.GAMM1.LT.1.D0) GO TO 29
  414. 28 GAMM1=100.D0
  415. 29 GAMM2=GAMTT(SIG0P(3),DSIGPP(3),R3)
  416. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM2
  417. IF(GAMM2.GE.1.D0) GAMM2=100.D0
  418. IF(GAMM2.LT.0.D0) GAMM2=0.D0
  419. GAMMA=DMIN1(GAMM1,GAMM2)
  420. IF(GAMMA.GE.1.D0) GO TO 23
  421. C
  422. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  423. ITETA=1
  424. IF(GAMMA.EQ.GAMM1) ITETA=2
  425. DENOR=DMIN1(GAMM1,GAMM2)
  426. DENOR=DMAX1(DENOR,RFPR)
  427. DIF=ABS(GAMM1-GAMM2)/DENOR
  428. IF(DIF.LE.PREC) ITETA=3
  429. GO TO(41,42,43),ITETA
  430. KERRE=640
  431. RETURN
  432. C
  433. C FISSURATION EN (R) PUIS EN (@)
  434. C
  435. 41 DSIGPP(2)=DSIGPP(2)*GAMMA
  436. ITETA=2
  437. GO TO 47
  438. C
  439. C FISSURATION EN (R) PUIS EN (Z)
  440. C
  441. 42 DSIGPP(2)=DSIGPP(2)*GAMMA
  442. DSIGPP(3)=DSIGPP(3)*GAMMA
  443. ITETA=2
  444. GO TO 30
  445. C
  446. C FISSURATION EN (R) PUIS EN (Z@)
  447. C
  448. 43 DSIGPP(2)=DSIGPP(2)*GAMMA
  449. ITETA=4
  450. IRZ=3
  451. GO TO 47
  452. C
  453. C******************** FISSURATION EN (Z) PUIS EN (R) ET (@) ************
  454. C
  455. 32 WW1(1)=ROTA(SIGEL,CC,SS,CS,1)
  456. CRIT=WW1(1)-R1
  457. IF(CRIT.LE.0.D0) GO TO 33
  458. C
  459. CRIT3=SIGEL(3)-R3
  460. IF(CRIT3.LE.0.D0) GO TO 206
  461. C
  462. SIG0P(1)=SIG0P(1)-SIMER
  463. SIG0P(3)=SIG0P(3)-SIMER
  464. DSIGPP(1)=DSIGPP(1)+SIMER
  465. DSIGPP(3)=DSIGPP(3)+SIMER
  466. C
  467. IF(DSIGPP(1).EQ.0.D0) GO TO 35
  468. GAMM1=(R1-SIG0P(1))/DSIGPP(1)
  469. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM1
  470. IF(GAMM1.LT.0.D0) GAMM1=0.D0
  471. IF(GAMM1.GE.0.D0.AND.GAMM1.LT.1.D0) GO TO 36
  472. 35 GAMM1=100.D0
  473. 36 GAMM2=GAMTT(SIG0P(3),DSIGPP(3),R3)
  474. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM2
  475. IF(GAMM2.GE.1.D0) GAMM2=100.D0
  476. IF(GAMM2.LT.0.D0) GAMM2=0.D0
  477. GAMMA=DMIN1(GAMM1,GAMM2)
  478. IF(GAMMA.GE.1.D0) GO TO 23
  479. C
  480. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  481. ITETA=1
  482. IF(GAMMA.EQ.GAMM1) ITETA=2
  483. DENOR=DMIN1(GAMM1,GAMM2)
  484. DENOR=DMAX1(DENOR,RFPR)
  485. DIF=ABS(GAMM1-GAMM2)/DENOR
  486. IF(DIF.LE.PREC) ITETA=3
  487. GO TO(51,52,53),ITETA
  488. WRITE(IOIMP,1001)ITETA
  489. KERRE=640
  490. RETURN
  491. C
  492. C FISSURATION EN (Z) PUIS EN (@)
  493. C
  494. 51 DSIGPP(1)=DSIGPP(1)*GAMMA
  495. ITETA=3
  496. GO TO 47
  497. C
  498. C FISSURATION EN (Z) PUIS EN (R)
  499. C
  500. 52 DSIGPP(2)=DSIGPP(2)*GAMMA
  501. DSIGPP(3)=DSIGPP(3)*GAMMA
  502. ITETA=3
  503. GO TO 37
  504. C
  505. C FISSURATION EN (Z) PUIS EN (R@)
  506. C
  507. 53 DSIGPP(1)=DSIGPP(1)*GAMMA
  508. ITETA=4
  509. IRZ=3
  510. GO TO 47
  511. C
  512. C********************* FISSURATION EN (RZ) PUIS EN (@) *****************
  513. C
  514. 33 CRIT3=SIGEL(3)-R3
  515. IF(CRIT3.LE.0.D0) GO TO 23
  516. SIG0P(3)=SIG0P(3)-SIMER
  517. DSIGPP(3)=DSIGPP(3)+SIMER
  518. C
  519. GAMMA=GAMTT(SIG0P(3),DSIGPP(3),R3)
  520. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  521. IF(GAMMA.GE.1.D0) GO TO 23
  522. IF(GAMMA.LT.0.D0) GAMMA=0.D0
  523. C
  524. C CORRECTION DES INCREMENTS DE CONTRAINTES
  525. C
  526. GO TO(61,62,63),IND
  527. WRITE(IOIMP,1000)IND
  528. KERRE=640
  529. RETURN
  530. C
  531. C FISSURE EN (R) PUIS EN (@)
  532. C
  533. 61 DSIGPP(2)=DSIGPP(2)*GAMMA-(1.D0-GAMMA)*SIMER
  534. ITETA=2
  535. GO TO 47
  536. C
  537. C FISSURE EN (Z) PUIS EN (@)
  538. C
  539. 62 DSIGPP(1)=DSIGPP(1)*GAMMA-(1.D0-GAMMA)*SIMER
  540. ITETA=3
  541. GO TO 47
  542. C
  543. C FISSURE EN (RZ) PUIS EN (@)
  544. C
  545. 63 ITETA=4
  546. 47 DSIGPP(3)=DSIGPP(3)*GAMMA
  547. C
  548. DO 39 I=1,6
  549. SIGEL(I)=SIG0P(I)+DSIGPP(I)
  550. DSIGP(I)=DSIGP(I)*(1.D0-GAMMA)
  551. 39 CONTINUE
  552. C
  553. C RETOUR DANS LES AXES
  554. C
  555. WW1(1)=SIGEL(1)
  556. WW1(2)=SIGEL(2)
  557. WW1(3)=SIGEL(4)
  558. C
  559. CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  560. C
  561. ITETA=ITETA+3
  562. IND1=0
  563. IND2=0
  564. IND3=0
  565. IND=0
  566. JTRAC=ITRAC
  567. SIMER=0.D0
  568. GO TO 24
  569. C
  570. C***********************************************************************
  571. C********************** FISSURATION EN (R@) PUIS EN (Z) ****************
  572. C***********************************************************************
  573. C
  574. 25 WW1(2)=ROTA(SIGEL,CC,SS,CS,2)
  575. CRIT=WW1(2)-R2
  576. IF(CRIT.LE.0.D0) GO TO 23
  577. 205 SIG0P(2)=SIG0P(2)-SIMER
  578. DSIGPP(2)=DSIGPP(2)+SIMER
  579. IF(DSIGPP(2).EQ.0.D0) GO TO 23
  580. GAMMA=(R2-SIG0P(2))/DSIGPP(2)
  581. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  582. IF(GAMMA.GE.1.D0) GO TO 23
  583. IF(GAMMA.LT.0.D0) GAMMA=0.D0
  584. IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  585. DSIGPP(2)=DSIGPP(2)*GAMMA
  586. IF(ITETA.EQ.2) DSIGPP(3)=DSIGPP(3)*GAMMA-(1.D0-GAMMA)*SIMER
  587. 30 DO 44 I=1,6
  588. SIGEL(I)=SIG0P(I)+DSIGPP(I)
  589. DSIGP(I)=DSIGP(I)*(1.D0-GAMMA)
  590. 44 CONTINUE
  591. C
  592. C RETOUR DANS LES AXES
  593. C
  594. WW1(1)=SIGEL(1)
  595. WW1(2)=SIGEL(2)
  596. WW1(3)=SIGEL(4)
  597. C
  598. CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  599. C
  600. ITETA=ITETA+2
  601. IND1=0
  602. IND2=0
  603. IND3=0
  604. IND=0
  605. IRZ=3
  606. JTRAC=ITRAC
  607. SIMER=0.D0
  608. GO TO 24
  609. C
  610. C***********************************************************************
  611. C*********************** FISSURATION EN (Z@) PUIS EN (R) ***************
  612. C***********************************************************************
  613. C
  614. 26 WW1(1)=ROTA(SIGEL,CC,SS,CS,1)
  615. CRIT=WW1(1)-R1
  616. IF(CRIT.LE.0.D0) GO TO 23
  617. 206 SIG0P(1)=SIG0P(1)-SIMER
  618. DSIGPP(1)=DSIGPP(1)+SIMER
  619. IF(DSIGPP(1).EQ.0.D0) GO TO 23
  620. GAMMA=(R1-SIG0P(1))/DSIGPP(1)
  621. IF(GAMMA.GE.1.D0) GO TO 23
  622. IF(GAMMA.LT.0.D0) GAMMA=0.D0
  623. DSIGPP(1)=DSIGPP(1)*GAMMA
  624. IF(ITETA.EQ.2) DSIGPP(3)=DSIGPP(3)*GAMMA-(1.D0-GAMMA)*SIMER
  625. 37 DO 46 I=1,6
  626. SIGEL(I)=SIG0P(I)+DSIGPP(I)
  627. DSIGP(I)=DSIGP(I)*(1.D0-GAMMA)
  628. 46 CONTINUE
  629. C
  630. C RETOUR DANS LES AXES
  631. C
  632. WW1(1)=SIGEL(1)
  633. WW1(2)=SIGEL(2)
  634. WW1(3)=SIGEL(4)
  635. C
  636. CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  637. C
  638. ITETA=ITETA+1
  639. IND1=0
  640. IND2=0
  641. IND3=0
  642. IND=0
  643. IRZ=3
  644. JTRAC=ITRAC
  645. SIMER=0.D0
  646. GO TO 24
  647. C
  648. C***********************************************************************
  649. C****************************** PAS DE COUPLAGE ************************
  650. C***********************************************************************
  651. C
  652. 23 ITENS=ITENRZ+ITENTE
  653. DO 9 III=1,6
  654. SIGMAT(III)=SIGEL(III)
  655. 9 CONTINUE
  656. GO TO 300
  657. C
  658. C***********************************************************************
  659. C****************************** LES FISSURES SE FERMENT ****************
  660. C***********************************************************************
  661. C
  662. 4 CONTINUE
  663. IF(IIMPI.EQ.9) WRITE(IOIMP,7002) (SIGMAT(I),I=1,6)
  664. DO 10 III=1,6
  665. SIGEL(III)=SIGMAT(III)
  666. 10 CONTINUE
  667. C
  668. C***********************************************************************
  669. C**** CALCUL DE LA QUANTITE DE CONTRAINTE A ECOULER AVEC LE CRITERE ****
  670. C* DE LA TRACTION AVANT D ARRIVER AU CRITERE DE DRUCKER PRAGER ECROUI *
  671. C***********************************************************************
  672. C
  673. 300 IF(IBAB.EQ.1) GO TO 331
  674. IF(ICTD.EQ.1) GO TO 332
  675. CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  676. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
  677. IF(CRIT.LE.0.D0) GO TO 331
  678. C
  679. C RETOUR DANS LES AXES
  680. C
  681. WW1(1)=SIGMA(1)
  682. WW1(2)=SIGMA(2)
  683. WW1(3)=SIGMA(4)
  684. C
  685. CALL RETOUR(WW1,SIGMA,CC,SS,CS,LUNE)
  686. C
  687. DO 301 I=1,6
  688. DSIGMA(I)=SIGMAT(I)-SIGMA(I)
  689. 301 CONTINUE
  690. C
  691. C CALCUL DE GAMMA CISAILLEMENT
  692. C
  693. GAMCIS=GAMDP(SIGMA,DSIGMA,ALFAD2,DPELA2,ICONCA,
  694. . PREC,RFSG,RFEP,RFPR)
  695. IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6)
  696. IF(IIMPI.EQ.9) WRITE(IOIMP,7014) (DSIGMA(I),I=1,6)
  697. IF(IIMPI.EQ.9) WRITE(IOIMP,7007) GAMCIS,CRIT
  698. IF(GAMCIS.GE.1.D0) GO TO 331
  699. IF(GAMCIS.LT.0.D0) GAMCIS=0.D0
  700. IF(GAMCIS.LT.RFPR*PREC) GAMCIS=0.D0
  701. C
  702. C ON RECOMMENCE AVEC GAMCIS*DSIGP AU LIEU DE DSIGP
  703. C
  704. DO 302 I=1,6
  705. SIGEL(I)=SIGEL0(I)
  706. DSIGP(I)=GAMCIS*DSIGP0(I)
  707. 302 CONTINUE
  708. R1=R10
  709. R2=R20
  710. R3=R30
  711. TETAQ=TETAQ0
  712. ITRAC=ITRAC0
  713. ITETA=ITETA0
  714. IRZ=IRZ0
  715. ICTD=1
  716. IF(GAMCIS.NE.0.D0) GO TO 96
  717. ITENS=0
  718. ITENRZ=0
  719. ITENTE=0
  720. GO TO 332
  721. C
  722. C***********************************************************************
  723. C**************************** LA SORTIE ********************************
  724. C***********************************************************************
  725. C
  726. 331 DO 303 I=1,6
  727. SIGMA(I)=SIGEL(I)
  728. DSIGMA(I)=0.D0
  729. DSIGP(I)=0.D0
  730. 303 CONTINUE
  731. GO TO 333
  732. C
  733. 332 DO 304 I=1,6
  734. SIGMA(I)=SIGEL(I)
  735. DSIGMA(I)=DSIGP0(I)*(1.D0-GAMCIS)
  736. SIGMAT(I)=SIGMA(I)+DSIGMA(I)
  737. DSIGP(I)=DSIGMA(I)
  738. 304 CONTINUE
  739. C
  740. 333 IF(IBAB.EQ.0) CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  741. .DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGEL,FSIG,CRIT,
  742. .KERRE)
  743. IF(IIMPI.EQ.9)
  744. . WRITE(IOIMP,7009) CRIT,R1,R2,R3,TETAQ,ICTD,ITRAC,ITENRZ,
  745. . ITENTE,ITENS
  746. IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6)
  747. IF(IIMPI.EQ.9) WRITE(IOIMP,7014) (DSIGMA(I),I=1,6)
  748. IF(IIMPI.EQ.9) WRITE(IOIMP,7002) (SIGMAT(I),I=1,6)
  749. IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6)
  750. IF(IIMPI.EQ.9) WRITE(IOIMP,7006) (DSIGP(I),I=1,6)
  751. C
  752. 1000 FORMAT(1X,'ERREUR DANS CRACK DANS LA VALEUR DE IND =',I4)
  753. 1001 FORMAT(1X,'ERREUR DANS CRACK DANS LA VALEUR DE ITETA =',I4)
  754. 1002 FORMAT(1X,'ERREUR DANS CRACK PAS DE CONVERGENCE ITER =',I4)
  755. 7000 FORMAT(1X,'ITRAC =',I4,1X,'ITENRZ=',I4,1X,'ITENTE=',I4,/,
  756. . 1X,'ITETA =',I4,1X,'IRZ =',I4,1X,'ITER =',I4)
  757. 7001 FORMAT(1X,'SIGEL =',6(1X,1PD12.5))
  758. 7002 FORMAT(1X,'SIGMAT=',6(1X,1PD12.5))
  759. 7003 FORMAT(1X,'SIG0P =',6(1X,1PD12.5))
  760. 7004 FORMAT(1X,'DSIGPP=',6(1X,1PD12.5))
  761. 7005 FORMAT(1X,'SIGTP =',6(1X,1PD12.5))
  762. 7006 FORMAT(1X,'DSIGP =',6(1X,1PD12.5))
  763. 7007 FORMAT(1X,'GAMCIS=',1PD12.5,1X,'CRIT =',1PD12.5)
  764. 7008 FORMAT(1X,'GAMMA =',1PD12.5)
  765. 7009 FORMAT(1X,'CRIT =',1PD12.5,1X,'R1 =',1PD12.5,
  766. . 1X,'R2 =',1PD12.5,/,
  767. . 1X,'R3 =',1PD12.5,1X,'TETAQ =',1PD12.5,/,
  768. . 1X,'ICTD =',I4,1X,'ITRAC =',I4,1X,'ITENRZ=',I4,
  769. . 1X,'ITENTE=',I4,1X,'ITENS =',I4)
  770. 7011 FORMAT(1X,'IND =',I4,1X,'IND1 =',I4,
  771. . 1X,'IND2 =',I4,1X,'IND3 =',I4)
  772. 7012 FORMAT(1X,'ITETA =',I4)
  773. 7013 FORMAT(1X,'SIGMA =',6(1X,1PD12.5))
  774. 7014 FORMAT(1X,'DSIGMA=',6(1X,1PD12.5))
  775. C
  776. RETURN
  777. END
  778.  
  779.  

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