Télécharger xdp.eso

Retour à la liste

Numérotation des lignes :

  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.  
  74.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales