Sources Esope | Cast3M

gamtsf
C GAMTSF    SOURCE    CHAT      05/01/13    00:15:51     5004
      SUBROUTINE GAMTSF(TENS,DTENS,RT,GAM)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION TENS(3),DTENS(3)
C
C--------------------------------------------
C     CETTE ROUTINE  PERMET DE CALCULER     |
C     GAMMA POUR ARRIVER SUR LE CRITERE     |
C     DE TRACTION DANS LE CAS SANS FISSURE  |
C--------------------------------------------
C
      A=4.D0*DTENS(1)*DTENS(2)-4.D0*DTENS(3)*DTENS(3)
      B=-4.D0*RT*(DTENS(1)+DTENS(2))+4.D0*TENS(1)*DTENS(2)
     1 +4.D0*TENS(2)*DTENS(1)-8.D0*TENS(3)*DTENS(3)
      C=4.D0*TENS(1)*TENS(2)-4.D0*TENS(3)*TENS(3)+4.D0*RT*RT
     1 -4.D0*RT*(TENS(1)+TENS(2))
C
C-----------------------------------------
C     RESOLUTION EQUATION 2EME DEGRE
C-----------------------------------------
C
      X1=0.D0
      X2=0.D0
      IF(A.EQ.0.D0) GOTO 1000
      B=B/A
      C=C/A
      A=1.D0
      DIS=B*B-4.D0*A*C
      ADIS=ABS(DIS)
      IF(DIS.GE.0.D0) THEN
      DIS=SQRT(ADIS)
      X2=(-B+DIS)/2.D0
      X1=(-B-DIS)/2.D0
      GOTO 2000
      ENDIF
      IF(ADIS.LE.1.E-8) THEN
      X1=-B/2.D0
      X2=X1
      GOTO 2000
      ENDIF
      IF(ADIS.GT.1.E-8) THEN
      X1=0.D0
      X2=0.D0
      GOTO 2000
      ENDIF
 1000 IF(B.EQ.0.D0) THEN
      X1=0.D0
      X2=0.D0
      GOTO 2000
      ENDIF
      X1=-C/B
      X2=X1
 2000 CONTINUE
      S1=(2.D0*RT-X1*(DTENS(1)+DTENS(2))-(TENS(1)+TENS(2)))/RT
      S2=(2.D0*RT-X2*(DTENS(1)+DTENS(2))-(TENS(1)+TENS(2)))/RT
      GAM=0.D0
      IF(S1.LT.-1.E-9) GAM=X2
      IF(S2.LT.-1.E-9) GAM=X1
      IF(S1.GE.-1.E-9.AND.S2.GE.-1.E-9) GAM=MIN(X1,X2)
      IF(X1.LT.-1.E-9) GAM=X2
      IF(X2.LT.-1.E-9) GAM=X1
      IF(GAM.LT.0.D0) GAM=0.D0
      IF(GAM.GT.1.D0) GAM=1.D0
      RETURN
      END