Télécharger ecubi1.eso

Retour à la liste

Numérotation des lignes :

  1. C ECUBI1 SOURCE CHAT 05/01/12 23:28:00 5004
  2. SUBROUTINE ECUBI1(SOG1,DSOG1,GAMMA1,PHI1,PSI1,NCAS,TRA1,XNU,
  3. 1 YOUNG,COHE1,TSUG,DEFPL,DLAM1,CO11,SI11,HACHE1,IDAM,KERRE)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. DIMENSION DEFPL(*),TSUG1(4),SOG1(*),DSOG1(*),DSAG1(4),SAG1(4),
  7. 1 DSUG1(4),SYG1(4),SUG1(4),TSUG(4),DEFPL1(4),DSUG(4),DSEG1(4)
  8. ITER=0
  9. ZER=0.D0
  10. DLA1=0.D0
  11. IDAM=1
  12. DO 48 ITYP=1,4
  13. DEFPL(ITYP)=0.D0
  14. 48 CONTINUE
  15. C ---------------------------------------------------------
  16. C ON EFFECTUE L'ECOULEMENT1 .PAS DE 2EME CRITERE
  17. C ---------------------------------------------------------
  18. C ----------------------------------------------
  19. C ON SE PLACE SUR LE CRITERE 1
  20. C
  21. DO 90 ITYP=1,4
  22. SAG1(ITYP)=SOG1(ITYP)+GAMMA1*DSOG1(ITYP)
  23. DSAG1(ITYP)=(1.D0-GAMMA1)*DSOG1(ITYP)
  24. 90 CONTINUE
  25. C ----------------------------------------------
  26. C --------------------------------------------------------
  27. C CALCUL DE DLAMDA
  28. C
  29. CIS1=SIGN(1.D0,SAG1(4))
  30. 457 VCRIT1=VCRITE(SAG1(2),SAG1(4),PHI1,COHE1)
  31. DLA1=(PHI1*DSAG1(2)+CIS1
  32. 1 *DSAG1(4)+VCRIT1)/HACHE1
  33. C--------------------------
  34. C CAS DEFO PLANES
  35. C
  36. IF(NCAS.NE.1) CALL DPHOOK(ZER,PSI1*DLA1,ZER,CIS1
  37. 1 *DLA1,DSUG1(1),DSUG1(2),DSUG1(3),DSUG1(4),XNU,YOUNG)
  38. C--------------------------
  39. C CAS CONT PLANES
  40. C
  41. IF(NCAS.EQ.1) CALL CPHOOK(ZER,PSI1*DLA1,ZER,
  42. # CIS1*DLA1,DSUG1(1),DSUG1(2)
  43. # ,DSUG1(3),DSUG1(4),XNU,YOUNG)
  44. C--------------------------
  45. DO 91 ITYP=1,4
  46. TSUG1(ITYP)=DSAG1(ITYP)+SAG1(ITYP)-DSUG1(ITYP)
  47. 91 CONTINUE
  48. C---------------------------------------------------------
  49. C----------------------------------------------------
  50. C CAS OU ON DEPASSE LA LIMITE EN TRACTION
  51. C ON CALCULE UN NOUVEAU DLAMDA
  52. C
  53. IF(ITER.EQ.0) GO TO 234
  54. DO 77 ITYP=1,4
  55. DSUG1(ITYP)=DSOG1(ITYP)+SOG1(ITYP)-TSUG1(ITYP)
  56. 77 CONTINUE
  57. DLAM1=DLAM1+DLA1
  58. GO TO 700
  59. 234 IF(TSUG1(2).LE.TRA1) DLAM1=DLAM1+DLA1
  60. IF(TSUG1(2).LE.TRA1) GO TO 700
  61. C--------------------------
  62. C CAS DEFO PLANES
  63. C
  64. IF(NCAS.NE.1) CALL DPHOOK(ZER,PSI1,ZER,CIS1
  65. 1 ,SYG1(1),SYG1(2),SYG1(3),SYG1(4),XNU,YOUNG)
  66. C--------------------------
  67. C CAS CONT PLANES
  68. C
  69. IF(NCAS.EQ.1) CALL CPHOOK(ZER,PSI1,ZER,CIS1
  70. 1 ,SYG1(1),SYG1(2),SYG1(3),SYG1(4),XNU,YOUNG)
  71. C--------------------------
  72. C ON CALCULE UN NOUVEAU DLAMDA
  73. C
  74. XAT=(TRA1-SAG1(2)+VCRIT1*SYG1(2)/HACHE1)/(DSAG1(2)-SYG1(2)*(DLA1
  75. 1 -VCRIT1/HACHE1))
  76. DLA1=XAT*(DLA1-VCRIT1/HACHE1)+VCRIT1/HACHE1
  77. C-----------------------------------------------------
  78. C ON CALCULE LES CONTRAINTES A LA POINTE ET
  79. C L INCREMENT DE CONTRAINTES
  80. C ON EFFECTUE L ECOULEMENT EN RAMENANT A LA POINTE
  81. C DU CRITERE
  82. C AVANT ON REGARDE SI ON PEUT ECOULER SUIVANT L'AUTRE
  83. C DIRECTION D'ECOULEMENT
  84. C-----------------------------------------------------
  85. C
  86. DO 92 ITYP=1,4
  87. TSUG1(ITYP)=SAG1(ITYP)+XAT*DSAG1(ITYP)-DLA1*SYG1(ITYP)
  88. DSEG1(ITYP)=DSAG1(ITYP)*(1.D0-XAT)
  89. 92 CONTINUE
  90. VCRT=-DSEG1(2)+PSI1*ABS(DSEG1(4))
  91. IF(VCRT.LE.0.D0.OR.ITER.GT.0) GO TO 456
  92. ITER=ITER+1
  93. CIS1=SIGN(1.D0,DSEG1(4))
  94. DLAM1=DLAM1+DLA1
  95. DO 97 ITYP=1,4
  96. SAG1(ITYP)=TSUG1(ITYP)
  97. DSAG1(ITYP)=DSEG1(ITYP)
  98. 97 CONTINUE
  99. GO TO 457
  100. C-----------------------------------------------------
  101. C CAS DEFO PLANES
  102. C
  103. 456 CONTINUE
  104. IF (NCAS.NE.1) HOOK=YOUNG/(1.D0+XNU)/(1.D0-2.D0*XNU)
  105. IF (NCAS.NE.1) ALPHA=(DSEG1(2)+TSUG1(2)-TRA1)/HOOK /(1.D0-XNU)
  106. IF (NCAS.NE.1) BETA=(DSEG1(4)+TSUG1(4))/HOOK/(1.D0-2.D0*XNU)
  107. C--------------------------
  108. C CAS CONT PLANES
  109. C
  110. IF (NCAS.EQ.1) HOOK=YOUNG/(1.D0-XNU*XNU)
  111. IF (NCAS.EQ.1) ALPHA=(DSEG1(2)+TSUG1(2)-TRA1)/HOOK
  112. IF (NCAS.EQ.1) BETA=(DSEG1(4)+TSUG1(2))/HOOK/(1.D0-XNU)
  113. C-----------------------------------------------------
  114. IF(NCAS.EQ.1) CALL CPHOOK(ZER,ALPHA,ZER,
  115. # BETA,DSAG1(1),DSAG1(2)
  116. # ,DSAG1(3),DSAG1(4),XNU,YOUNG)
  117. IF(NCAS.NE.1) CALL DPHOOK(ZER,ALPHA,ZER,
  118. # BETA,DSAG1(1),DSAG1(2)
  119. # ,DSAG1(3),DSAG1(4),XNU,YOUNG)
  120. DO 453 ITYP=1,4
  121. TSUG1(ITYP)=TSUG1(ITYP)+DSEG1(ITYP)-DSAG1(ITYP)
  122. DSUG1(ITYP)=DSOG1(ITYP)+SOG1(ITYP)-TSUG1(ITYP)
  123. 453 CONTINUE
  124. DLAM1=DLA1+SQRT((ALPHA*ALPHA+BETA*BETA)/(PSI1*PSI1+1.D0))+DLAM1
  125. 700 CALL CHREPE (CO11,-SI11,DSUG1,DSUG)
  126. CALL CHREPE (CO11,-SI11,TSUG1,TSUG)
  127. C-----------------------------------------------------
  128. C CAS DEFO PLANES
  129. C
  130. IF(NCAS.NE.1) CALL DPCONT(DSUG,DEFPL,XNU,YOUNG)
  131. C--------------------------
  132. C CAS CONT PLANES
  133. C
  134. IF (NCAS.EQ.1) CALL CPCONT(DSUG,DEFPL,XNU,YOUNG)
  135. C-----------------------------------------------------
  136. RETURN
  137. END
  138.  
  139.  

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