Télécharger la plaquette Cast3M


fr en

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