Télécharger ecubi2.eso

Retour à la liste

Numérotation des lignes :

  1. C ECUBI2 SOURCE CHAT 05/01/12 23:28:05 5004
  2. SUBROUTINE ECUBI2 (SOG1,DSOG1,GAMMA1,PHI1,PSI1,NCAS,TRA1,
  3. 1 XNU,YOUNG,COHE1,HACHE1,CO11,SI11,
  4. 2 PHI2,PSI2,COHE2,CO22,SI22,HACHE2,TRA2,
  5. 3 CO21,SI21,TSUG,DEFPL,DLAM,ICHR,SOGMA,DSOGMA,KERRE)
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. -INC CCOPTIO
  10. C
  11. DIMENSION DSOG1(4),SOG1(4),DEFPL(4),SOGMA(4),DSOGMA(4),
  12. 1 SUG1(4),DSUG1(4),SIP1(4),SAP1(4),SYG1(4),DSAG1(4),SAG1(4),
  13. 2 TSUG2(4),SUG2(4),SIP2(4),SAP2(4),EPPLA1(4),TSUG(4),DSUG(4)
  14. 3 ,TSUG1(4),DSEG1(4),TSEG1(4),TSEG2(4),DSOG2(4),DSIG1(4)
  15. ICHR=0
  16. ZER=0.D0
  17. ITER=0
  18. DLA=0.D0
  19. C-------------------------------------------------
  20. C ON EFFECTUE L'ECOULEMENT1 SANS COUPLAGE
  21. C-------------------------------------------------
  22. C --------------------------------
  23. DO 90 ITYP=1,4
  24. C
  25. C ON SE PLACE SUR LE CRITERE 1
  26. C
  27. SAG1(ITYP)=SOG1(ITYP)+GAMMA1*DSOG1(ITYP)
  28. DSAG1(ITYP)=(1-GAMMA1)*DSOG1(ITYP)
  29. 90 CONTINUE
  30. C --------------------------------
  31. C -----------------------------------------------
  32. C
  33. C CALCUL DE DLAMDA
  34. C
  35. CIS1=SIGN(1.D0,SAG1(4))
  36. 457 VCRIT1=VCRITE(SAG1(2),SAG1(4),PHI1,COHE1)
  37. DLA=(PHI1*DSAG1(2)+CIS1
  38. 1 *DSAG1(4)+VCRIT1)/HACHE1
  39. C----------------------------------------------
  40. C---------------------------
  41. C CAS DEFO PLANES
  42. C
  43. IF(NCAS.NE.1) CALL DPHOOK(ZER,PSI1*DLA,ZER,CIS1
  44. 1 *DLA,DSUG1(1),DSUG1(2),DSUG1(3),DSUG1(4),XNU,YOUNG)
  45. C---------------------------
  46. C---------------------------
  47. C CONT PLANES
  48. C
  49. IF(NCAS.EQ.1) CALL CPHOOK(ZER,PSI1*DLA,ZER,CIS1
  50. 1 *DLA,DSUG1(1),DSUG1(2),DSUG1(3),DSUG1(4),XNU,YOUNG)
  51. C---------------------------
  52. C---------------------------------------------------
  53. C ON EFFECTUE L ECOULEMENT
  54. C
  55. DO 91 ITYP=1,4
  56. TSUG1(ITYP)=DSAG1(ITYP)+SAG1(ITYP)-DSUG1(ITYP)
  57. 91 CONTINUE
  58. C---------------------------------------------------
  59. C ON REGARDE SI LE CRITERE 2 EST ENDOMMAGE
  60. C OU SI ON DEPASSE LA LIMITE EN TRACTION
  61. C
  62. CALL CHREPE(CO21,SI21,TSUG1,TSUG2)
  63. VCRI1=VCRITE(TSUG1(2),TSUG1(4),PHI1,COHE1)
  64. IF(IIMPI.EQ.28) WRITE(IOIMP,1978) VCRI1
  65. VCRIT2=VCRITE(TSUG2(2),TSUG2(4),PHI2,COHE2)
  66. C
  67. IF(TSUG1(2).LE.TRA1.AND.VCRIT2.LE.0.D0) DLAM=DLAM+DLA
  68. IF(TSUG1(2).LE.TRA1.AND.VCRIT2.LE.0.D0) GO TO 500
  69. C-----------------------
  70. C CAS DEFO PLANES
  71. C
  72. DLB=DLA
  73. IF(NCAS.NE.1) CALL DPHOOK(ZER,PSI1,ZER,CIS1
  74. 1 ,SYG1(1),SYG1(2),SYG1(3),SYG1(4),XNU,YOUNG)
  75. C-----------------------
  76. C CAS CONT PLANES
  77. C
  78. IF(NCAS.EQ.1) CALL CPHOOK(ZER,PSI1,ZER,CIS1
  79. 1 ,SYG1(1),SYG1(2),SYG1(3),SYG1(4),XNU,YOUNG)
  80. C-----------------------
  81. C---------------------------------------------------
  82. C-------------------------------------------------
  83. C CAS OU ON DEPASSE LA LIMITE EN TRACTION
  84. C ON CALCULE UN NOUVEAU DLAMDA
  85. C
  86. IF(TSUG1(2).LE.TRA1) GO TO 700
  87. XAT=(TRA1-SAG1(2)+VCRIT1*SYG1(2)/HACHE1)/(DSAG1(2)-SYG1(2)*(DLA-
  88. 1 VCRIT1/HACHE1))
  89. DLA=XAT*(DLA-VCRIT1/HACHE1)+VCRIT1/HACHE1
  90. DO 102 ITYP=1,4
  91. TSUG1(ITYP)=SAG1(ITYP)+XAT*DSAG1(ITYP)-DLA*SYG1(ITYP)
  92. 102 CONTINUE
  93. IF(IIMPI.EQ.28) WRITE(IOIMP,3333)
  94. 3333 FORMAT('0 ON A DEPASSE LA LIMITE EN TRACTION')
  95. C-------------------------------------------------
  96. C-------------------------------------------------------------
  97. C LE CRITERE 2 EST ENDOMMAGE QUAND ON EST A LA
  98. C POINTE DU CRITERE 1
  99. C ON CALCULE UN NOUVEAU DLAMDA
  100. C
  101. CALL CHREPE(CO21,SI21,TSUG1,TSUG2)
  102. 1978 FORMAT( '0 ECUBI4 VCRIT1 =',1PE12.5/)
  103. VCR=VCRITE(TSUG2(2),TSUG2(4),PHI2,COHE2)
  104. IF(VCR.LE.0) GO TO 750
  105. 700 VCRIT1=VCRITE(SAG1(2),SAG1(4),PHI1,COHE1)
  106. IF(IIMPI.EQ.28) WRITE(IOIMP,1978) VCRIT1
  107. DLA=(PHI1*DSAG1(2)+CIS1
  108. 1 *DSAG1(4)+VCRIT1)/HACHE1
  109. DO 101 ITYP=1,4
  110. SIP1(ITYP)=SAG1(ITYP)-VCRIT1/HACHE1*SYG1(ITYP)
  111. SAP1(ITYP)=DSAG1(ITYP)-(DLA-VCRIT1/HACHE1)*SYG1(ITYP)
  112. 101 CONTINUE
  113. IF(IIMPI.EQ.28) WRITE(IOIMP,4333)
  114. 4333 FORMAT('0 ON A ENDOMMAGE LE 2 CRITERE')
  115. CALL CHREPE(CO21,SI21,SIP1,SIP2)
  116. CALL CHREPE(CO21,SI21,SAP1,SAP2)
  117. XBT=-(PHI2*SIP2(2)+SIGN(1.D0,SIP2(4)+SAP2(4))*SIP2(4)-COHE2)/(
  118. 1 PHI2*SAP2(2)+SIGN(1.D0,SIP2(4)+SAP2(4))*SAP2(4))
  119. XCT=-(PHI2*SIP2(2)-SIGN(1.D0,SIP2(4)+SAP2(4))*SIP2(4)-COHE2)/(
  120. 1 PHI2*SAP2(2)-SIGN(1.D0,SIP2(4)+SAP2(4))*SAP2(4))
  121. XAT=MIN(XBT,XCT)
  122. IF(XBT.LE.0.D0) XAT=XCT
  123. IF(XCT.LE.0.D0) XAT=XBT
  124. IF(IIMPI.EQ.28) WRITE(IOIMP,3888) DLA,XAT,XBT,XCT
  125. 3888 FORMAT( '0 ECUBI4 DLA XAT XBT XCT ',4(1X,1PE12.5)/)
  126. DLA=XAT*(DLA-VCRIT1/HACHE1)+VCRIT1/HACHE1
  127. IF(IIMPI.EQ.28) WRITE(IOIMP,3889) DLA
  128. 3889 FORMAT('0 ECUBI4 DLA=',1PE12.5/)
  129. DO 105 ITYP=1,4
  130. SUG1(ITYP)=SAG1(ITYP)+XAT*DSAG1(ITYP)-DLA*SYG1(ITYP)
  131. SAG1(ITYP)=SAG1(ITYP)+XAT*DSAG1(ITYP)-SUG1(ITYP)
  132. DSUG1(ITYP)=DSAG1(ITYP)*(1.D0-XAT)
  133. 105 CONTINUE
  134. C-------------------------
  135. C IL FAUT APPELLE LE COUPLAGE
  136. C-------------------------
  137. CALL CHREPE(CO11,-SI11,SUG1,SOGMA)
  138. VCRIT1=VCRITE(SUG1(2),SUG1(4),PHI1,COHE1)
  139. IF(IIMPI.EQ.28) WRITE(IOIMP,1978) VCRIT1
  140. CALL CHREPE(CO11,-SI11,DSUG1,DSOGMA)
  141. CALL CHREPE(CO11,-SI11,SAG1,DSAG1)
  142. IF (NCAS.NE.1) CALL DPCONT(DSAG1,DEFPL,XNU,YOUNG)
  143. IF (NCAS.EQ.1) CALL CPCONT(DSAG1,DEFPL,XNU,YOUNG)
  144. ICHR=1
  145. DLAM=DLAM+DLA
  146. IF(IIMPI.EQ.28) WRITE(IOIMP,1111) ITER
  147. 1111 FORMAT('0 ITER= ',E12.5/)
  148. RETURN
  149. C-------------------------------------------------------------
  150. 750 DO 103 ITYP=1,4
  151. DSIG1(ITYP)=DSAG1(ITYP)*(1.D0-XAT)
  152. 103 CONTINUE
  153. VCRT=-DSIG1(2)+PSI1*ABS(DSIG1(4))
  154. IF(VCRT.LE.0.D0.OR.ITER.LE.1) GO TO 456
  155. ITER=ITER+1
  156. CIS1=SIGN(1.D0,DSIG1(4))
  157. DO 97 ITYP=1,4
  158. SAG1(ITYP)=TSUG1(ITYP)
  159. DSAG1(ITYP)=DSIG1(ITYP)
  160. 97 CONTINUE
  161. DLAM=DLAM+DLA
  162. GO TO 457
  163. 456 IF (NCAS.NE.1) HOOK=YOUNG/(1.D0+XNU)/(1.D0-2.D0*XNU)
  164. IF (NCAS.NE.1) ALPHA=(DSIG1(2)+TSUG1(2)-TRA1)/HOOK /(1.D0-XNU)
  165. IF (NCAS.NE.1) BETA=(DSIG1(4)+TSUG1(4))/HOOK/(1.D0-2.D0*XNU)
  166. C--------------------------
  167. C CAS CONT PLANES
  168. C
  169. IF (NCAS.EQ.1) HOOK=YOUNG/(1.D0-XNU*XNU)
  170. IF (NCAS.EQ.1) ALPHA=(DSIG1(2)+TSUG1(2)-TRA1)/HOOK
  171. IF (NCAS.EQ.1) BETA=(DSIG1(4)+TSUG1(4))/HOOK/(1.D0-XNU)
  172. C-----------------------------------------------------
  173. IF(NCAS.EQ.1) CALL CPHOOK(ZER,ALPHA,ZER,
  174. # BETA,DSEG1(1),DSEG1(2)
  175. # ,DSEG1(3),DSEG1(4),XNU,YOUNG)
  176. IF(NCAS.NE.1) CALL DPHOOK(ZER,ALPHA,ZER,
    # BETA,DSEG1(1),DSEG1(2)
  177. # ,DSEG1(3),DSEG1(4),XNU,YOUNG)
  178. DO 453 ITYP=1,4
  179. TSEG1(ITYP)=TSUG1(ITYP)+DSIG1(ITYP)-DSEG1(ITYP)
  180. DSUG1(ITYP)=DSOG1(ITYP)+SOG1(ITYP)-TSEG1(ITYP)
  181. 453 CONTINUE
  182. C-------------------------------------
  183. C ON REGARDE SI ON ENDOMMAGE LE 2 EME CRITERE
  184. C-------------------------------------
  185. C
  186. CALL CHREPE(CO21,SI21,TSEG1,TSUG2)
  187. VCRTA=VCRITE(TSUG2(2),TSUG2(4),PHI2,COHE2)
  188. IF(IIMPI.EQ.28) WRITE(IOIMP,2978) VCRTA
  189. 2978 FORMAT( '0 ECUBI VCRTA =',1PE12.5/)
  190. IF(VCRTA.LE.0.) GO TO 522
  191. C CALL CHREPE(CO21,SI21,DSUG1,DSUG2)
  192. C
  193. IF(ABS(DSEG1(4)).LE.1.D-7) ATS=0.D0
  194. IF(ABS(DSEG1(4)).LE.1.D-7) BTS=1.D0
  195. IF(ABS(DSEG1(4)).LE.1.D-7) GOTO 543
  196. C ATS=(TSUG1(4)-TRA1)/DSEG1(4)
  197. ATS=TSUG1(4)/DSEG1(4)
  198. C BTS=DSIG1(2)/DSEG1(2)
  199. BTS=DSIG1(4)/DSEG1(4)
  200. 543 DO 987 ITYP=1,4
  201. SIP1(ITYP)=TSUG1(ITYP)-ATS*DSEG1(ITYP)
  202. SAP1(ITYP)=DSIG1(ITYP)-BTS*DSEG1(ITYP)
  203. 987 CONTINUE
  204. CALL CHREPE(CO21,SI21,SIP1,SIP2)
  205. CALL CHREPE(CO21,SI21,SAP1,SAP2)
  206. XCT=-(PHI2*SIP2(2)+SIGN(1.D0,SIP2(4)+SAP2(4))*SIP2(4)-COHE2)/
  207. 1 (PHI2*SAP2(2)+SIGN(1.D0,SIP2(4)+SAP2(4))*SAP2(4))
  208. XDT=-(PHI2*SIP2(2)-SIGN(1.D0,SIP2(4)+SAP2(4))*SIP2(4)-COHE2)/
  209. 1 (PHI2*SAP2(2)-SIGN(1.D0,SIP2(4)+SAP2(4))*SAP2(4))
  210. IF(XCT.LE.0.D0) XCT=100.D0
  211. IF(XDT.LE.0.D0) XDT=100.D0
  212. XAT=MIN(XCT,XDT)
  213. IF(XAT.GT.1.) XAT=0.D0
  214. XBT=ATS+XAT*BTS
  215. IF(IIMPI.EQ.28) WRITE(IOIMP,3978) XAT,XBT,XCT,XDT
  216. 3978 FORMAT( '0 ECUBI XAT XBT XCT XDT ',4(1X,1PE12.5)/)
  217. DO 195 ITYP=1,4
  218. TSUG1(ITYP)=TSUG1(ITYP)+XAT*DSIG1(ITYP)-DSEG1(ITYP)*XBT
  219. DSUG1(ITYP)=DSOG1(ITYP)+SOG1(ITYP)-TSUG1(ITYP)
  220. DSOG1(ITYP)=(1.D0-XAT)*DSIG1(ITYP)
  221. 195 CONTINUE
  222. CALL CHREPE(CO11,-SI11,TSUG1,SOGMA)
  223. CALL CHREPE(CO11,-SI11,DSOG1,DSOGMA)
  224. CALL CHREPE(CO11,-SI11,DSUG1,DSUG)
  225. ICHR=1
  226. IF (NCAS.NE.1) CALL DPCONT(DSUG,DEFPL,XNU,YOUNG)
  227. IF (NCAS.EQ.1) CALL CPCONT(DSUG,DEFPL,XNU,YOUNG)
  228. DLAM=DLAM+DLA*XBT
  229. IF(IIMPI.EQ.28) WRITE(IOIMP,1111) ITER
  230. RETURN
  231. 522 CALL CHREPE(CO11,-SI11,TSEG1,TSUG)
  232. DO 32 ITYP=1,4
  233. TSUG1(ITYP)=TSEG1(ITYP)
  234. 32 CONTINUE
  235. DLAM=DLA+SQRT((ALPHA*ALPHA+BETA*BETA)/(PSI1*PSI1+1.D0))+DLAM
  236. GOTO 523
  237. 500 CALL CHREPE(CO11,-SI11,TSUG1,TSUG)
  238. 523 CONTINUE
  239. DO 31 ITYP=1,4
  240. DSUG1(ITYP)=-TSUG1(ITYP)+DSOG1(ITYP)+SOG1(ITYP)
  241. 31 CONTINUE
  242. CALL CHREPE(CO11,-SI11,DSUG1,DSUG)
  243. IF (NCAS.NE.1) CALL DPCONT(DSUG,DEFPL,XNU,YOUNG)
  244. IF (NCAS.EQ.1) CALL CPCONT(DSUG,DEFPL,XNU,YOUNG)
  245. IF(IIMPI.EQ.28) WRITE(IOIMP,1111) ITER
  246. RETURN
  247. END
  248.  
  249.  

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