Télécharger t1c2dp.eso

Retour à la liste

Numérotation des lignes :

t1c2dp
  1. C T1C2DP SOURCE CHAT 05/01/13 03:29:16 5004
  2. SUBROUTINE T1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,HDP,
  3. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPPLDP,ALPHA,KERRE)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. DIMENSION SIG(3),DSIG(3),SGG(3),DSGG(3),SFG(3),DSFG(3),
  10. 1 A(3),B(3),IDAM(3),EPC(3),SSI(3),SI(3),EPC1(3),SG1(3),
  11. 1 SG2(3),EC1(3),EC2(3),AT(4),BT(2),EPDP(3),EPPLDP(3),TENS(3)
  12. ITER=0
  13. Y=YOUN/(1.D0-ANU*ANU)
  14. DO 5 ITYP=1,3
  15. EPPLDP(ITYP)=0.D0
  16. 5 EPDP(ITYP)=0.D0
  17. XT=0.D0
  18. IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
  19. 9999 FORMAT(1X,'T1C2DP TRIPLAGE TRACTION 1 COMP 2 DRUCKER',/)
  20. 9998 FORMAT(1X,'T1C2DP ',I4,'ITERATIONS INTERNES',/)
  21. C
  22. C------------------------------------------------
  23. C TRIPLAGE TRACTION 1 COMPRESSION 2 DRUCKER
  24. C------------------------------------------------
  25. C----------------------------------------------
  26. C DEFINITION D UNE CONTRAINTE DE REFERENCE
  27. C SI RMAX DU DRUCKER INFERIEURE A CETTE VALEUR
  28. C ALORS SIGMA=0
  29. C----------------------------------------------
  30. C
  31. RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  32. SIREF=1.E-6*YOUN
  33. C
  34. C--------------------------------------------------
  35. C CAS OU LE RAYON DU DRUCKER EST INFERIEUR
  36. C A UNE VALEUR DE REFERENCE
  37. C--------------------------------------------------
  38. C
  39. IF(SIREF.GT.RMAX) THEN
  40. DO 10 ITYP=1,3
  41. 10 SIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  42. RDP=0.D0
  43. HDP=0.D0
  44. ADP=0.D0
  45. CALL NORME(SIG,DL3)
  46. DL3=DL3/YOUN*10.D0
  47. XLAM3=XLAM3+DL3
  48. CALL CPHOIN(SIG,EPPLDP,YOUN,ANU)
  49. DO 20 ITYP=1,3
  50. IDAM(ITYP)=0
  51. DSIG(ITYP)=0.D0
  52. 20 SIG(ITYP)=0.D0
  53. IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  54. RETURN
  55. ENDIF
  56. C-----------------------------------------------
  57. C ON SE PLACE DANS LE REPERE DE FISSURATION
  58. C-----------------------------------------------
  59. C
  60. CALL CHREP(SIG,SFG,ANG)
  61. CALL CHREP(DSIG,DSFG,ANG)
  62. C
  63. C-----------------------------------------------------
  64. C ESTIMATION DU PAS D'INCREMENT DE CONTRAINTES
  65. C-----------------------------------------------------
  66. C
  67. CALL SIJ(SFG,SI,SIETOI)
  68. CALL EPSDP(SI,SIETOI,ADP,EPC)
  69. CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA)
  70. CALL SCAL2(EPC,SSI,VAL)
  71. VAL=VAL-HDP
  72. IF(VAL.LT.0.D0) THEN
  73. KERRE=459
  74. RETURN
  75. ENDIF
  76. CALL SCAL(SSI,DSFG,VAL)
  77. CALL NORME(DSFG,VA1)
  78. CALL NORME(SSI,VA2)
  79. IF(VA1.EQ.0.D0) THEN
  80. IDAM(1)=0
  81. IDAM(2)=0
  82. IDAM(3)=0
  83. RETURN
  84. ENDIF
  85. RMIN=MIN((RDP/1.73),(RDP/(1.D0+2.D0*ADP)))
  86. X=VAL/VA1/VA2
  87. IF(X.GE.1.D0) THEN
  88. X=1.D0
  89. GOTO 25
  90. ENDIF
  91. X=1.D0/SQRT(1.0001D0-X*X)*RMIN/VA1/8.D0
  92. IF(X.GT.1.D0) X=1.D0
  93. C
  94. C----------------------------------------------------------
  95. C ON ECOULE ET ON REGARDE LA VARIATION DE NORMALE
  96. C----------------------------------------------------------
  97. C
  98. C
  99. C---------------------------------------
  100. C RESOLUTION DU SYSTEME EN DL3
  101. C---------------------------------------
  102. 25 X=X/2.D0
  103. EC1(1)=1.D0
  104. EC1(2)=0.D0
  105. EC1(3)=0.D0
  106. EC2(1)=0.D0
  107. EC2(2)=1.D0
  108. EC2(3)=0.D0
  109. CALL CPHOOB(EC1,SG1,YOUN,ANU)
  110. CALL CPHOOB(EC2,SG2,YOUN,ANU)
  111. 51 X=X*2.D0
  112. 52 RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  113. ITER=ITER+1
  114. 653 IF(ITER.GT.200) THEN
  115. KERRE=460
  116. RETURN
  117. ENDIF
  118. IF(SIREF.GT.RMAX) THEN
  119. RDP=0.D0
  120. ADP=0.D0
  121. HDP=0.D0
  122. DO 60 ITYP=1,3
  123. 60 SFG(ITYP)=SFG(ITYP)+(1.D0-XT)*DSFG(ITYP)
  124. CALL NORME(SFG,DL3)
  125. DL3=DL3/YOUN*10.D0
  126. XLAM3=XLAM3+DL3
  127. CALL CPHOIN(SFG,EPPLDP,YOUN,ANU)
  128. DO 70 ITYP=1,3
  129. 70 EPDP(ITYP)=EPDP(ITYP)+EPPLDP(ITYP)
  130. CALL CHREP(EPDP,EPPLDP,-ANG)
  131. DO 80 ITYP=1,3
  132. IDAM(ITYP)=0
  133. DSIG(ITYP)=0.D0
  134. 80 SIG(ITYP)=0.D0
  135. IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  136. RETURN
  137. ENDIF
  138. IF((XT+X).GT.1.D0) X=1.D0-XT
  139. CALL SIJ(SFG,SI,SIETOI)
  140. CALL EPSDP(SI,SIETOI,ADP,EPC)
  141. CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA)
  142. CALL SCAL2(EPC,SSI,VAL)
  143. VAL=VAL-HDP
  144. IF(VAL.LT.0.D0) THEN
  145. KERRE=459
  146. RETURN
  147. ENDIF
  148. C
  149. 90 ITER=ITER+1
  150. IF(ITER.GT.201) GOTO 653
  151. IDAM(2)=-1
  152. AT(1)=Y-H1
  153. AT(4)=Y
  154. AT(2)=Y*ANU
  155. AT(3)=AT(2)
  156. DO 95 ITYP=1,3
  157. 95 DSGG(ITYP)=X*DSFG(ITYP)
  158. BT(1)=SFG(1)+DSGG(1)-RT1
  159. BT(2)=SFG(2)+DSGG(2)
  160. CALL SYLIN2(AT,BT,DL11,DL21)
  161. BT(1)=-SSI(1)
  162. BT(2)=-SSI(2)
  163. CALL SYLIN2(AT,BT,DL12,DL22)
  164. DO 100 ITYP=1,3
  165. A(ITYP)=SFG(ITYP)+DSGG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP)
  166. 100 B(ITYP)=-DL12*SG1(ITYP)-DL22*SG2(ITYP)-SSI(ITYP)
  167. CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST)
  168. IF(ITEST.EQ.1) THEN
  169. X=X/2.D0
  170. GOTO 90
  171. ENDIF
  172. DL1=DL11+DL3*DL12
  173. DL2=DL21+DL3*DL22
  174. DO 105 ITYP=1,3
  175. SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP)
  176. 105 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP)
  177. IF(DL1.LT.-1.D-10) IDAM(1)=0
  178. IF(DL2.GT.1.D-10) IDAM(2)=0
  179. IF(DL3.LT.-1.D-10) IDAM(3)=0
  180. IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0.OR.IDAM(3).EQ.0) THEN
  181. DL1=0.D0
  182. DL2=0.D0
  183. DL3=0.D0
  184. X=0.D0
  185. GOTO 2000
  186. ENDIF
  187. C
  188. C-------------------------------------------------------
  189. C ON VERIFIE SI LA NORMALE DU DRUCKER VARIE PEU
  190. C-------------------------------------------------------
  191. C
  192. CALL SIJ(SGG,SI,SIETOI)
  193. CALL EPSDP(SI,SIETOI,ADP,EPC1)
  194. CALL SCAL(EPC,EPC1,VAL)
  195. CALL NORME(EPC,VA1)
  196. CALL NORME(EPC1,VA2)
  197. CO=VAL/VA1/VA2
  198. IF(CO.LT.0.99) THEN
  199. X=X/2.D0
  200. GOTO 90
  201. ENDIF
  202. RD=RDP-DL3*HDP
  203. RMAX=MAX((RD/1.73),(RD/(1.D0-2.D0*ADP)))
  204. IF(RMAX.LT.SIREF) THEN
  205. RDP=0.D0
  206. GOTO 52
  207. ENDIF
  208. C
  209. C-------------------------------------------------
  210. C CAS OU LA TRACTION PASSE EN DESSOUS DE 0
  211. C-------------------------------------------------
  212. C
  213. IF((RT1-H1*DL1).GE.-1.E-10) GOTO 200
  214. C
  215. IF(H1.EQ.0.D0) H1=1.D0
  216. DL1=RT1/H1
  217. AT(1)=-DSFG(1)
  218. AT(3)=-DSFG(2)
  219. AT(4)=Y
  220. AT(2)=Y*ANU
  221. BT(1)=SFG(1)-DL1*SG1(1)
  222. BT(2)=SFG(2)-DL1*SG1(2)
  223. CALL SYLIN2(AT,BT,X1,DL21)
  224. BT(1)=-SSI(1)
  225. BT(2)=-SSI(2)
  226. CALL SYLIN2(AT,BT,X2,DL22)
  227. DO 110 ITYP=1,3
  228. A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL1*SG1(ITYP)-DL21*SG2(ITYP)
  229. 110 B(ITYP)=X2*DSFG(ITYP)-DL22*SG2(ITYP)-SSI(ITYP)
  230. CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  231. DO 111 ITYP=1,3
  232. SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  233. 111 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  234. CALL SIJ(SGG,SI,SIETOI)
  235. CALL EPSDP(SI,SIETOI,ADP,EPC1)
  236. CALL SCAL(EPC,EPC1,VAL)
  237. CALL NORME(EPC,VA1)
  238. CALL NORME(EPC1,VA2)
  239. CO1=VAL/VA1/VA2
  240. CALL SIJ(DSGG,SI,SIETOI)
  241. CALL EPSDP(SI,SIETOI,ADP,EPC1)
  242. CALL SCAL(EPC,EPC1,VAL)
  243. CALL NORME(EPC,VA1)
  244. CALL NORME(EPC1,VA2)
  245. CO2=VAL/VA1/VA2
  246. XIN1=X1+X2*DL31
  247. XIN2=X1+X2*DL32
  248. DLIN1=DL21+DL31*DL22
  249. DLIN2=DL21+DL32*DL22
  250. IF(XIN1.GT.-1.E-10.AND.DLIN1.LT.1.E-10.AND.XIN1.LE.X
  251. 1 .AND.CO1.GT.0.9) THEN
  252. DL3=DL31
  253. X=XIN1
  254. DL2=DLIN1
  255. GOTO 200
  256. ENDIF
  257. IF(XIN2.GT.-1.E-10.AND.DLIN2.LT.1.E-10.AND.XIN2.LE.X
  258. 1 .AND.CO2.GT.0.9) THEN
  259. DL3=DL32
  260. X=XIN2
  261. DL2=DLIN2
  262. GOTO 200
  263. ENDIF
  264. IF(IIMPI.EQ.9) WRITE(IOIMP,10101)
  265. 10101 FORMAT(1X,'ERREUR DANS T1C2DP TRAC',/)
  266. DL3=DL31
  267. X=XIN1
  268. DL2=DLIN1
  269. 200 IF((XLAM2+DL2).GE.0.D0) GOTO 300
  270. C
  271. C-------------------------------------------------
  272. C CAS OU LA FISSURE 2 EST TOTALEMENT FERME
  273. C-------------------------------------------------
  274. C
  275. C
  276. IDAM(2)=0
  277. DL2=-XLAM2
  278. AT(1)=-DSFG(1)
  279. AT(3)=-DSFG(2)
  280. AT(2)=Y-H1
  281. AT(4)=Y*ANU
  282. BT(1)=SFG(1)-DL2*SG2(1)-RT1
  283. BT(2)=SFG(2)-DL2*SG2(2)
  284. CALL SYLIN2(AT,BT,X1,DL11)
  285. BT(1)=-SSI(1)
  286. BT(2)=-SSI(2)
  287. CALL SYLIN2(AT,BT,X2,DL12)
  288. DO 210 ITYP=1,3
  289. A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL11*SG1(ITYP)-DL2*SG2(ITYP)
  290. 210 B(ITYP)=X2*DSFG(ITYP)-DL12*SG1(ITYP)-SSI(ITYP)
  291. CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  292. DO 211 ITYP=1,3
  293. SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  294. 211 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  295. CALL SIJ(SGG,SI,SIETOI)
  296. CALL EPSDP(SI,SIETOI,ADP,EPC1)
  297. CALL SCAL(EPC,EPC1,VAL)
  298. CALL NORME(EPC,VA1)
  299. CALL NORME(EPC1,VA2)
  300. CO1=VAL/VA1/VA2
  301. CALL SIJ(DSGG,SI,SIETOI)
  302. CALL EPSDP(SI,SIETOI,ADP,EPC1)
  303. CALL SCAL(EPC,EPC1,VAL)
  304. CALL NORME(EPC,VA1)
  305. CALL NORME(EPC1,VA2)
  306. CO2=VAL/VA1/VA2
  307. XIN1=X1+X2*DL31
  308. XIN2=X1+X2*DL32
  309. DLIN1=DL11+DL31*DL12
  310. DLIN2=DL11+DL32*DL12
  311. IF(XIN1.GT.-1.E-10.AND.DLIN1.GT.-1.E-10.AND.XIN1.LE.X
  312. 1 .AND.CO1.GT.0.9) THEN
  313. DL3=DL31
  314. X=XIN1
  315. DL1=DLIN1
  316. GOTO 300
  317. ENDIF
  318. IF(XIN2.GT.-1.E-10.AND.DLIN2.GT.-1.E-10.AND.XIN2.LE.X
  319. 1 .AND.CO2.GT.0.9) THEN
  320. DL3=DL32
  321. X=XIN2
  322. DL1=DLIN2
  323. GOTO 300
  324. ENDIF
  325. IF(IIMPI.EQ.9) WRITE(IOIMP,20202)
  326. 20202 FORMAT(1X,'ERREUR DANS T1C2DP FERM',/)
  327. DL3=DL31
  328. X=XIN1
  329. DL1=DLIN1
  330. 300 DO 310 ITYP=1,3
  331. SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP)
  332. 310 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP)
  333. RDP=RDP-DL3*HDP
  334. RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  335. IF(RMAX.LT.SIREF) THEN
  336. RDP=0.D0
  337. GOTO 52
  338. ENDIF
  339. XT=XT+X
  340. DO 330 ITYP=1,3
  341. EPDP(ITYP)=EPDP(ITYP)+DL3*EPC(ITYP)
  342. 330 SFG(ITYP)=SGG(ITYP)
  343. XLAM1=XLAM1+DL1
  344. XLAM2=XLAM2+DL2
  345. XLAM3=XLAM3+DL3
  346. RT1=RT1-H1*DL1
  347. IF(RT1.LT.1.E-10) THEN
  348. H1=0.D0
  349. RT1=0.D0
  350. ENDIF
  351. IF(XLAM2.LT.1.E-10) THEN
  352. IDAM(2)=0
  353. XLAM2=0.D0
  354. ENDIF
  355. IF(IDAM(2).EQ.0) THEN
  356. XLAM2=0.D0
  357. C
  358. DO 340 ITYP=1,3
  359. DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)
  360. 340 TENS(ITYP)=SFG(ITYP)+DSFG(ITYP)
  361. GAMTR1=10.D0
  362. GAMTR2=10.D0
  363. GAMCO1=10.D0
  364. C
  365. GAMDP=10.D0
  366. CALL CTRAF(TENS(1),RT1,VCTR1)
  367. CALL CTRAF(TENS(2),RT2,VCTR2)
  368. CALL CCOAF(TENS(1),XLAM1,VCCO1)
  369. C
  370. CALL CDP(TENS,ADP,RDP,VCDP)
  371. IF(VCTR1.GT.0.D0) CALL GAMTAF(SFG(1),DSFG(1),RT1,GAMTR1)
  372. IF(VCTR2.GT.0.D0) CALL GAMTAF(SFG(2),DSFG(2),RT2,GAMTR2)
  373. IF(VCCO1.GT.0.D0) CALL GAMCAF(SFG(1),DSFG(1),GAMCO1)
  374. C
  375. IF(VCDP.GT.0.D0) CALL GDP(SFG,DSFG,RDP,ADP,GAMDP)
  376. IDAM(1)=0
  377. IDAM(2)=0
  378. IDAM(3)=0
  379. GAM=MIN(GAMTR1,GAMTR2,GAMCO1,GAMDP)
  380. IF(GAM.GE.1.D0) THEN
  381. DO 341 ITYP=1,3
  382. SFG(ITYP)=SFG(ITYP)+DSFG(ITYP)
  383. 341 DSIG(ITYP)=0.D0
  384. CALL CHREP(SFG,SIG,-ANG)
  385. CALL CHREP(EPDP,EPPLDP,-ANG)
  386. IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  387. RETURN
  388. ENDIF
  389. IF(ABS(GAM-GAMTR1).LE.1.E-10) IDAM(1)=1
  390. IF(ABS(GAM-GAMCO1).LE.1.E-10) IDAM(1)=-1
  391. IF(ABS(GAM-GAMTR2).LE.1.E-10) IDAM(2)=1
  392. C
  393. IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1
  394. DO 342 ITYP=1,3
  395. SFG(ITYP)=SFG(ITYP)-GAM*DSFG(ITYP)
  396. 342 DSFG(ITYP)=(1.D0-GAM)*DSFG(ITYP)
  397. CALL CHREP(SFG,SIG,-ANG)
  398. CALL CHREP(DSFG,DSIG,-ANG)
  399. CALL CHREP(EPDP,EPPLDP,-ANG)
  400. IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  401. RETURN
  402. ENDIF
  403. C=1.D0-1.D-10
  404. IF(XT.GE.C) THEN
  405. DO 350 ITYP=1,3
  406. IDAM(ITYP)=0
  407. 350 DSIG(ITYP)=0.D0
  408. CALL CHREP(SFG,SIG,-ANG)
  409. CALL CHREP(EPDP,EPPLDP,-ANG)
  410. IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  411. RETURN
  412. ENDIF
  413. GOTO 51
  414. 2000 CONTINUE
  415. CALL CHREP(SFG,SIG,-ANG)
  416. DO 2010 ITYP=1,3
  417. 2010 DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)
  418. CALL CHREP(DSFG,DSIG,-ANG)
  419. CALL CHREP(EPDP,EPPLDP,-ANG)
  420. IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  421. RETURN
  422. END
  423.  
  424.  

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