Télécharger c1c2.eso

Retour à la liste

Numérotation des lignes :

  1. C C1C2 SOURCE CHAT 05/01/12 21:44:44 5004
  2. SUBROUTINE C1C2(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,
  3. 1 XLAM1,XLAM2,IDAM,ANG)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC CCOPTIO
  7. DIMENSION SIG(3),DSIG(3),SFC(3),DSFC(3),TSFC(3),SFG(3),DSFG(3),
  8. 1 EPC(3),A(4),B(2),IDAM(3),EPC1(3),EPC2(3),SG(3),DSG(3),SG1(3),
  9. 1 SG2(3),TENS(3)
  10. Y=YOUN/(1.D0-ANU*ANU)
  11. C
  12. C--------------------------------------------------------
  13. C FERMETURE DES FISSURES DANS LES DEUX DIRECTIONS |
  14. C--------------------------------------------------------
  15. C
  16. C-------------------------------------------------
  17. C ON SE PLACE DANS LE REPERE DE FISSURATION
  18. C-------------------------------------------------
  19. C
  20. IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
  21. 9999 FORMAT(1X,'C1C2 COUPLAGE COMP 1 COMP 2',/)
  22. IC1=0
  23. IC2=0
  24. CALL CHREP(SIG,SFG,ANG)
  25. CALL CHREP(DSIG,DSFG,ANG)
  26. C
  27. C------------------------------------------
  28. C OBTENTION DU SYSTEME EN DL1 DL2
  29. C------------------------------------------
  30. C
  31. B(1)=DSFG(1)+SFG(1)
  32. B(2)=DSFG(2)+SFG(2)
  33. A(1)=Y
  34. A(4)=Y
  35. A(2)=ANU*Y
  36. A(3)=A(2)
  37. CALL SYLIN2(A,B,DL1,DL2)
  38. C
  39. C-----------------------------------------------
  40. C CAS DES FAUX COUPLAGES DL1 OU DL2 POSITIF
  41. C-----------------------------------------------
  42. C
  43. IF(DL1.GT.1.E-10) IDAM(1)=0
  44. IF(DL2.GT.1.E-10) IDAM(2)=0
  45. IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0) RETURN
  46. IF(DL1.LT.-XLAM1) IC1=1
  47. IF(DL2.LT.-XLAM2) IC2=1
  48. C
  49. C-----------------------------------------------
  50. C CAS OU ON FERME TOTALEMENT LA FISSURE 1
  51. C-----------------------------------------------
  52. C
  53. IF(DL1.LT.-XLAM1) GOTO 1000
  54. C
  55. C-----------------------------------------------
  56. C CAS OU ON FERME TOTALEMENT LA FISSURE 2
  57. C-----------------------------------------------
  58. C
  59. IF(DL2.LT.-XLAM2) GOTO 2000
  60. C
  61. C------------------------------------
  62. C ON EFFECTUE L ECOULEMENT
  63. C------------------------------------
  64. C
  65. EPC(1)=DL1
  66. EPC(2)=DL2
  67. EPC(3)=0.D0
  68. CALL CPHOOB(EPC,SFC,YOUN,ANU)
  69. DO 10 ITYP=1,3
  70. 10 TSFC(ITYP)=DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  71. C
  72. C------------------------------------------------
  73. C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE
  74. C PENDANT L 'ECOULEMENT (SINON 3000)
  75. C------------------------------------------------
  76. C
  77. CALL CDP(TSFC,ADP,RDP,VCDP)
  78. IF(VCDP.GT.0.D0) GOTO 3000
  79. C
  80. C------------------------------------------------
  81. C CAS OU L ECOULEMENT SE FAIT ENTIEREMENT
  82. C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
  83. C------------------------------------------------
  84. C
  85. XLAM1=XLAM1+DL1
  86. XLAM2=XLAM2+DL2
  87. IDAM(1)=0
  88. IDAM(2)=0
  89. IDAM(3)=0
  90. DO 20 ITYP=1,3
  91. 20 DSIG(ITYP)=0.D0
  92. CALL CHREP(TSFC,SIG,-ANG)
  93. RETURN
  94. C
  95. C------------------------------------------------
  96. C CAS OU LA FISSURE1 EST COMPLETEMENT FERMEE
  97. C------------------------------------------------
  98. C
  99. C------------------------------------------
  100. C OBTENTION DU SYSTEME EN X DL2
  101. C------------------------------------------
  102. C
  103. 1000 DL1=-XLAM1
  104. B(1)=-SFG(1)+DL1*Y
  105. B(2)=-SFG(2)+DL1*ANU*Y
  106. A(4)=-Y
  107. A(1)=DSFG(1)
  108. A(2)=-ANU*Y
  109. A(3)=DSFG(2)
  110. DET=A(1)*A(4)-A(2)*A(3)
  111. IF(DET.EQ.0.D0.AND.DL2.LT.-XLAM2) GOTO 2000
  112. IF(DET.EQ.0.D0) GOTO 2500
  113. CALL SYLIN2(A,B,X,DL2)
  114. IF(DL2.LT.-XLAM2) GOTO 2000
  115. EPC(1)=DL1
  116. EPC(2)=DL2
  117. EPC(3)=0.D0
  118. CALL CPHOOB(EPC,SFC,YOUN,ANU)
  119. DO 30 ITYP=1,3
  120. 30 SFC(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  121. C
  122. C------------------------------------------------
  123. C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE
  124. C PENDANT L 'ECOULEMENT (SINON 3000)
  125. C------------------------------------------------
  126. C
  127. CALL CDP(SFC,ADP,RDP,VCDP)
  128. IF(VCDP.GT.0.D0) GOTO 3000
  129. C
  130. C------------------------------------------------
  131. C L ECOULEMENT SE FAIT PARTIELLEMENT
  132. C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
  133. C ET DE L INCREMENT DSIGMA
  134. C------------------------------------------------
  135. C
  136. XLAM1=0.D0
  137. XLAM2=XLAM2+DL2
  138. DO 40 ITYP=1,3
  139. DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
  140. 40 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP)
  141. GOTO 2750
  142. C
  143. C------------------------------------------------
  144. C CAS OU LA FISSURE2 EST COMPLETEMENT FERMEE
  145. C------------------------------------------------
  146. C
  147. C------------------------------------------
  148. C OBTENTION DU SYSTEME EN X DL1
  149. C------------------------------------------
  150. C
  151. 2000 DL2=-XLAM2
  152. B(1)=-SFG(1)+DL2*ANU*Y
  153. B(2)=-SFG(2)+DL2*Y
  154. A(2)=-Y
  155. A(1)=DSFG(1)
  156. A(4)=-ANU*Y
  157. A(3)=DSFG(2)
  158. DET=A(1)*A(4)-A(2)*A(3)
  159. IF(DET.EQ.0.D0) GOTO 2500
  160. CALL SYLIN2(A,B,X,DL1)
  161. IF(DL1.LT.-XLAM1) GOTO 2500
  162. EPC(1)=DL1
  163. EPC(2)=DL2
  164. EPC(3)=0.D0
  165. CALL CPHOOB(EPC,SFC,YOUN,ANU)
  166. DO 130 ITYP=1,3
  167. 130 SFC(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  168. C
  169. C------------------------------------------------
  170. C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE
  171. C PENDANT L 'ECOULEMENT (SINON 3000)
  172. C------------------------------------------------
  173. C
  174. CALL CDP(SFC,ADP,RDP,VCDP)
  175. IF(VCDP.GT.0.D0) GOTO 3000
  176. C
  177. C------------------------------------------------
  178. C L ECOULEMENT SE FAIT PARTIELLEMENT
  179. C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
  180. C ET DE L INCREMENT DSIGMA
  181. C------------------------------------------------
  182. C
  183. XLAM2=0.D0
  184. XLAM1=XLAM1+DL1
  185. DO 140 ITYP=1,3
  186. DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
  187. 140 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP)
  188. GOTO 2750
  189. 2500 IF(IC1.EQ.1.AND.IC2.EQ.1) THEN
  190. DL1=-XLAM1
  191. DL2=-XLAM2
  192. XLAM1=0.D0
  193. XLAM2=0.D0
  194. CALL CPHOOB(EPC,SFC,YOUN,ANU)
  195. DO 150 ITYP=1,3
  196. SFC(ITYP)=SFG(ITYP)-SFC(ITYP)
  197. 150 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP)
  198. GOTO 2750
  199. ENDIF
  200. IF(IC1.EQ.1) THEN
  201. DL1=-XLAM1
  202. XLAM1=0.D0
  203. DL2=SFG(2)/Y-ANU*DL1
  204. IF(DL2.GT.0.D0) DL2=0.D0
  205. IF(DL2.LT.-XLAM2) DL2=-XLAM2
  206. XLAM2=XLAM2+DL2
  207. EPC(1)=DL1
  208. EPC(2)=DL2
  209. EPC(3)=0.D0
  210. CALL CPHOOB(EPC,SFC,YOUN,ANU)
  211. DO 153 ITYP=1,3
  212. SFC(ITYP)=SFG(ITYP)-SFC(ITYP)
  213. 153 TENS(ITYP)=DSFG(ITYP)+SFC(ITYP)
  214. GOTO 2750
  215. ENDIF
  216. IF(IC2.EQ.1) THEN
  217. DL2=-XLAM2
  218. XLAM2=0.D0
  219. DL1=SFG(1)/Y-ANU*DL2
  220. IF(DL1.GT.0.D0) DL1=0.D0
  221. IF(DL1.LT.-XLAM1) DL1=-XLAM1
  222. XLAM1=XLAM1+DL1
  223. EPC(1)=DL1
  224. EPC(2)=DL2
  225. EPC(3)=0.D0
  226. CALL CPHOOB(EPC,SFC,YOUN,ANU)
  227. DO 155 ITYP=1,3
  228. SFC(ITYP)=SFG(ITYP)-SFC(ITYP)
  229. 155 TENS(ITYP)=DSFG(ITYP)+SFC(ITYP)
  230. ENDIF
  231. 2750 IDAM(1)=0
  232. IDAM(2)=0
  233. IDAM(3)=0
  234. GAMDP=10.D0
  235. GAMTR1=10.D0
  236. GAMTR2=10.D0
  237. GAMCO1=10.D0
  238. GAMCO2=10.D0
  239. CALL CDP(TENS,ADP,RDP,VCDP)
  240. IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFG,RDP,ADP,GAMDP)
  241. CALL CTRAF(TENS(1),RT1,VCTR1)
  242. IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(1),DSFG(1),RT1,GAMTR1)
  243. CALL CCOAF(TENS(1),XLAM1,VCCO1)
  244. IF(VCCO1.GT.0.D0) CALL GAMCAF(SFC(1),DSFG(1),GAMCO1)
  245. CALL CTRAF(TENS(2),RT2,VCTR2)
  246. IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(2),DSFG(2),RT2,GAMTR2)
  247. CALL CCOAF(TENS(2),XLAM2,VCCO2)
  248. IF(VCCO2.GT.0.D0) CALL GAMCAF(SFC(2),DSFG(2),GAMCO2)
  249. GAM=MIN(GAMCO1,GAMDP,GAMTR1,GAMTR2,GAMCO2)
  250. IF(GAM.GE.1.D0) THEN
  251. DO 156 ITYP=1,3
  252. SFG(ITYP)=SFC(ITYP)+DSFG(ITYP)
  253. 156 DSIG(ITYP)=0.D0
  254. CALL CHREP(SFG,SIG,-ANG)
  255. RETURN
  256. ENDIF
  257. IF(ABS(GAM-GAMCO1).LT.1E-10) IDAM(1)=-1
  258. IF(ABS(GAM-GAMTR1).LT.1E-10) IDAM(1)=1
  259. IF(ABS(GAM-GAMCO2).LT.1E-10) IDAM(2)=-1
  260. IF(ABS(GAM-GAMTR2).LT.1E-10) IDAM(2)=1
  261. IF(ABS(GAM-GAMDP).LT.1E-10) IDAM(3)=1
  262. DO 157 ITYP=1,3
  263. SFG(ITYP)=SFC(ITYP)+GAM*DSFG(ITYP)
  264. 157 DSFG(ITYP)=DSFG(ITYP)*(1.D0-GAM)
  265. CALL CHREP(SFG,SIG,-ANG)
  266. CALL CHREP(DSFG,DSIG,-ANG)
  267. RETURN
  268. C
  269. C-----------------------------------------------------
  270. C CAS OU ON ENDOMMAGE LE DP PENDANT L ECOULEMENT
  271. C CALCUL DE X POUR ARRIVER SUR LE CRITERE
  272. C-----------------------------------------------------
  273. C
  274. 3000 CONTINUE
  275. EPC1(1)=1.D0
  276. EPC1(2)=0.D0
  277. EPC1(3)=0.D0
  278. EPC2(2)=1.D0
  279. EPC2(1)=0.D0
  280. EPC2(3)=0.D0
  281. CALL CPHOOB(EPC1,SG1,YOUN,ANU)
  282. CALL CPHOOB(EPC2,SG2,YOUN,ANU)
  283. B(1)=SFG(1)
  284. B(2)=SFG(2)
  285. A(4)=Y
  286. A(1)=A(4)
  287. A(2)=A(4)*ANU
  288. A(3)=A(2)
  289. CALL SYLIN2(A,B,DL11,DL21)
  290. B(1)=DSFG(1)
  291. B(2)=DSFG(2)
  292. CALL SYLIN2(A,B,DL12,DL22)
  293. DO 3010 ITYP=1,3
  294. SG(ITYP)=SFG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP)
  295. 3010 DSG(ITYP)=DSFG(ITYP)-DL12*SG1(ITYP)-DL22*SG2(ITYP)
  296. CALL XDP(SG,DSG,RDP,ADP,X,ITEST)
  297. IF(ITEST.EQ.1) THEN
  298. IDAM(1)=-1
  299. IDAM(2)=-1
  300. IDAM(3)=1
  301. RETURN
  302. ENDIF
  303. DL1=DL11+X*DL12
  304. DL2=DL21+X*DL22
  305. C
  306. C------------------------------------------------
  307. C L ECOULEMENT SE FAIT PARTIELLEMENT
  308. C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
  309. C ET DE L INCREMENT DSIGMA
  310. C------------------------------------------------
  311. C
  312. XLAM1=XLAM1+DL1
  313. XLAM2=XLAM2+DL2
  314. IDAM(1)=-1
  315. IDAM(2)=-1
  316. IDAM(3)=1
  317. IF(XLAM1.LT.1.E-8) THEN
  318. XLAM1=0.D0
  319. IDAM(1)=0
  320. ENDIF
  321. IF(XLAM2.LT.1.E-8) THEN
  322. XLAM2=0.D0
  323. IDAM(2)=0
  324. ENDIF
  325. EPC(1)=DL1
  326. EPC(2)=DL2
  327. EPC(3)=0.D0
  328. CALL CPHOOB(EPC,SFC,YOUN,ANU)
  329. DO 50 ITYP=1,3
  330. SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  331. 50 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
  332. CALL CHREP(DSFG,DSIG,-ANG)
  333. CALL CHREP(SFG,SIG,-ANG)
  334. RETURN
  335. END
  336.  
  337.  

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