Télécharger ecubi2.eso

Retour à la liste

Numérotation des lignes :

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

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