Télécharger la plaquette Cast3M


fr en

Télécharger ecubi1.eso

Retour à la liste

Numérotation des lignes : 

ecubi1

  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