1 : C GAMTSF SOURCE CHAT 05/01/13 00:15:51 5004 2 : SUBROUTINE GAMTSF(TENS,DTENS,RT,GAM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : DIMENSION TENS(3),DTENS(3) 6 : C 7 : C-------------------------------------------- 8 : C CETTE ROUTINE PERMET DE CALCULER | 9 : C GAMMA POUR ARRIVER SUR LE CRITERE | 10 : C DE TRACTION DANS LE CAS SANS FISSURE | 11 : C-------------------------------------------- 12 : C 13 : A=4.D0*DTENS(1)*DTENS(2)-4.D0*DTENS(3)*DTENS(3) 14 : B=-4.D0*RT*(DTENS(1)+DTENS(2))+4.D0*TENS(1)*DTENS(2) 15 : 1 +4.D0*TENS(2)*DTENS(1)-8.D0*TENS(3)*DTENS(3) 16 : C=4.D0*TENS(1)*TENS(2)-4.D0*TENS(3)*TENS(3)+4.D0*RT*RT 17 : 1 -4.D0*RT*(TENS(1)+TENS(2)) 18 : C 19 : C----------------------------------------- 20 : C RESOLUTION EQUATION 2EME DEGRE 21 : C----------------------------------------- 22 : C 23 : X1=0.D0 24 : X2=0.D0 25 : IF(A.EQ.0.D0) GOTO 1000 26 : B=B/A 27 : C=C/A 28 : A=1.D0 29 : DIS=B*B-4.D0*A*C 30 : ADIS=ABS(DIS) 31 : IF(DIS.GE.0.D0) THEN 32 : DIS=SQRT(ADIS) 33 : X2=(-B+DIS)/2.D0 34 : X1=(-B-DIS)/2.D0 35 : GOTO 2000 36 : ENDIF 37 : IF(ADIS.LE.1.E-8) THEN 38 : X1=-B/2.D0 39 : X2=X1 40 : GOTO 2000 41 : ENDIF 42 : IF(ADIS.GT.1.E-8) THEN 43 : X1=0.D0 44 : X2=0.D0 45 : GOTO 2000 46 : ENDIF 47 : 1000 IF(B.EQ.0.D0) THEN 48 : X1=0.D0 49 : X2=0.D0 50 : GOTO 2000 51 : ENDIF 52 : X1=-C/B 53 : X2=X1 54 : 2000 CONTINUE 55 : S1=(2.D0*RT-X1*(DTENS(1)+DTENS(2))-(TENS(1)+TENS(2)))/RT 56 : S2=(2.D0*RT-X2*(DTENS(1)+DTENS(2))-(TENS(1)+TENS(2)))/RT 57 : GAM=0.D0 58 : IF(S1.LT.-1.E-9) GAM=X2 59 : IF(S2.LT.-1.E-9) GAM=X1 60 : IF(S1.GE.-1.E-9.AND.S2.GE.-1.E-9) GAM=MIN(X1,X2) 61 : IF(X1.LT.-1.E-9) GAM=X2 62 : IF(X2.LT.-1.E-9) GAM=X1 63 : IF(GAM.LT.0.D0) GAM=0.D0 64 : IF(GAM.GT.1.D0) GAM=1.D0 65 : RETURN 66 : END 67 :
© Cast3M 2003 - All rights reserved.
Disclaimer