Télécharger gamtsf.eso

Retour à la liste

Numérotation des lignes :

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

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