Télécharger dlamdp.eso

Retour à la liste

Numérotation des lignes :

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

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