1 : C XDP SOURCE CHAT 05/01/13 04:13:27 5004 2 : SUBROUTINE XDP(TENS,DTENS,RDP,ADP,GAMDP,ITEST) 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 LE 9 : C POURCENTAGE DE L INCREMENT QUE L' ON PEUT 10 : C ECOULER AVANT D'AVOIR LE COUPLAGE 11 : C (DANS LE CAS DU DRUCKER PRAGER) 12 : C---------------------------------------------- 13 : C 14 : ITEST=0 15 : GAMDP=0.D0 16 : A=-ADP*(DTENS(1)+DTENS(2))*ADP*(DTENS(1)+DTENS(2)) 17 : 1 +DTENS(1)*DTENS(1)+DTENS(2)*DTENS(2)+3.D0*DTENS(3)*DTENS(3) 18 : 1 -DTENS(1)*DTENS(2) 19 : B=2.D0*ADP*(DTENS(1)+DTENS(2))*(RDP-ADP*(TENS(1)+TENS(2))) 20 : 1 +2.D0*DTENS(1)*TENS(1)+2.D0*DTENS(2)*TENS(2)+ 21 : 1 6.D0*DTENS(3)*TENS(3)-DTENS(1)*TENS(2)-DTENS(2)*TENS(1) 22 : C=RDP-ADP*(TENS(1)+TENS(2)) 23 : C=C*C 24 : C=-C+TENS(1)*TENS(1)+TENS(2)*TENS(2)+3.D0*TENS(3)*TENS(3) 25 : 1 -TENS(2)*TENS(1) 26 : X1=0.D0 27 : X2=0.D0 28 : IF(A.EQ.0.D0) GOTO 1000 29 : B=B/A 30 : C=C/A 31 : A=1.D0 32 : DIS=B*B-4.D0*A*C 33 : ADIS=ABS(DIS) 34 : IF(DIS.GT.0.D0) THEN 35 : DIS=SQRT(ADIS) 36 : X2=(-B+DIS)/2.D0 37 : X1=(-B-DIS)/2.D0 38 : GOTO 2000 39 : ENDIF 40 : IF(ADIS.LE.1.E-10) THEN 41 : X1=-B/2.D0 42 : X2=X1 43 : GOTO 2000 44 : ENDIF 45 : ITEST=1 46 : RETURN 47 : 1000 IF(B.EQ.0.D0) RETURN 48 : X1=-B/C 49 : X2=X1 50 : 2000 CONTINUE 51 : S1=RDP-ADP*(TENS(1)+TENS(2)+X1*(DTENS(1)+DTENS(2))) 52 : S2=RDP-ADP*(TENS(1)+TENS(2)+X2*(DTENS(1)+DTENS(2))) 53 : IF(RDP.NE.0.D0) THEN 54 : S1=S1/RDP 55 : S2=S2/RDP 56 : ENDIF 57 : IF(S1.GE.-1.E-10.AND.S2.GE.-1.E-10) THEN 58 : GAMDP=MAX(X1,X2) 59 : GOTO 3000 60 : ENDIF 61 : IF(S1.GE.-1.E-10.AND.S2.LT.-1.E-10) THEN 62 : GAMDP=X1 63 : GOTO 3000 64 : ENDIF 65 : IF(S1.LT.-1.E-10.AND.S2.GE.-1.E-10) THEN 66 : GAMDP=X2 67 : GOTO 3000 68 : ENDIF 69 : 3000 IF(GAMDP.LT.0.D0) GAMDP=0.D0 70 : IF(GAMDP.GT.1.D0) GAMDP=1.D0 71 : RETURN 72 : END 73 :
© Cast3M 2003 - All rights reserved.
Disclaimer