Télécharger c1c2dp.eso

Retour à la liste

Numérotation des lignes :

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

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