1 : C DLAMDP SOURCE CHAT 05/01/12 22:52:47 5004 2 : SUBROUTINE DLAMDP(TENS,DTENS,XLAM3,RDP,ADP,HDP,ITEST) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : DIMENSION TENS(3),DTENS(3) 6 : ITEST=0 7 : XLAM3=0.D0 8 : C 9 : C-------------------------------------------------------- 10 : C CETTE ROUTINE PERMET DE CALCULER LA VALEUR 11 : C DU DLAMDA ASSOCIE AU DRUCKER-PRAGER 12 : C-------------------------------------------------------- 13 : C 14 : A=ADP*(DTENS(1)+DTENS(2))+HDP 15 : A=-A*A 16 : A=A+DTENS(1)*DTENS(1)+DTENS(2)*DTENS(2)+3.D0*DTENS(3)*DTENS(3) 17 : 1 -DTENS(1)*DTENS(2) 18 : B=2.D0*(ADP*(DTENS(1)+DTENS(2))+HDP)*(RDP-ADP*(TENS(1)+TENS(2))) 19 : 1 +2.D0*DTENS(1)*TENS(1)+2.D0*DTENS(2)*TENS(2)+ 20 : 1 6.D0*DTENS(3)*TENS(3)-DTENS(1)*TENS(2)-DTENS(2)*TENS(1) 21 : C=RDP-ADP*(TENS(1)+TENS(2)) 22 : C=C*C 23 : C=-C+TENS(1)*TENS(1)+TENS(2)*TENS(2)+3.D0*TENS(3)*TENS(3) 24 : 1 -TENS(2)*TENS(1) 25 : X1=0.D0 26 : X2=0.D0 27 : IF(A.EQ.0.D0) GOTO 1000 28 : B=B/A 29 : C=C/A 30 : A=1.D0 31 : DIS=B*B-4.D0*A*C 32 : ADIS=ABS(DIS) 33 : IF(DIS.GE.0.D0) THEN 34 : DIS=SQRT(ADIS) 35 : X2=(-B+DIS)/2.D0 36 : X1=(-B-DIS)/2.D0 37 : GOTO 2000 38 : ENDIF 39 : ITEST=1 40 : RETURN 41 : 1000 IF(B.EQ.0.D0) THEN 42 : X1=0.D0 43 : X2=0.D0 44 : GOTO 2000 45 : ENDIF 46 : X1=-C/B 47 : X2=X1 48 : 2000 CONTINUE 49 : S1=RDP-ADP*(TENS(1)+TENS(2)+X1*(DTENS(1)+DTENS(2)))-HDP*X1 50 : S2=RDP-ADP*(TENS(1)+TENS(2)+X2*(DTENS(1)+DTENS(2)))-HDP*X2 51 : IF(RDP.NE.0.D0) THEN 52 : S1=S1/RDP 53 : S2=S2/RDP 54 : ENDIF 55 : IF(S1.GE.-1.E-10.AND.S2.GE.-1.E-10) THEN 56 : XLAM3=MIN(X1,X2) 57 : RETURN 58 : ENDIF 59 : IF(S1.GE.-1.E-10.AND.S2.LT.-1.E-10) THEN 60 : XLAM3=X1 61 : RETURN 62 : ENDIF 63 : IF(S1.LT.-1.E-10.AND.S2.GE.-1.E-10) THEN 64 : XLAM3=X2 65 : RETURN 66 : ENDIF 67 : IF(S1.LT.-1.E-10.AND.S2.LT.-1.E-10) THEN 68 : ITEST=1 69 : RETURN 70 : ENDIF 71 : END 72 :
© Cast3M 2003 - All rights reserved.
Disclaimer