Télécharger equat3.eso

Retour à la liste

Numérotation des lignes :

  1. C EQUAT3 SOURCE CB215821 16/04/22 21:15:02 8922
  2. SUBROUTINE EQUAT3(A,B,C,SIG1,SIG2,SIG3)
  3. C=======================================================================
  4. C
  5. C RESOLUTION D'UNE EQUATION DU 3EME DEGRE DE LA FORME:
  6. C X*X*X + A*X*X + B*X + C = 0
  7. C
  8. C=======================================================================
  9. C
  10. C ENTREES: A , B , C.
  11. C SORTIES: SIG1 , SIG2 , SIG3.
  12. C
  13. C=======================================================================
  14. C
  15. C CREATION : F.CORMERY
  16. C E.N.S.M.A - LMPM
  17. C DEC 1992
  18. C
  19. C=======================================================================
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8 (A-H,O-Z)
  22.  
  23. DATA DEUX/2.D0/,TROIS/3.D0/,QUATRE/4.D0/,DM6/1.D-8/,PETIT/1.D-12/
  24. DATA A27/27.D0/,UN/1.D0/,XUN/-1.D0/
  25.  
  26. -INC CCREEL
  27.  
  28. C-----------------------------------------------------------------------
  29. P=B-A*A/TROIS
  30. Q=(DEUX*A*A*A/A27)-((A*B)/TROIS)+C
  31. XIMAGI=(QUATRE*P*P*P)+A27*Q*Q
  32. AXIMAG=ABS(XIMAGI)
  33. C--------------------------
  34. IF(XIMAGI.GT.XZERO.AND.AXIMAG.GT.DM6) GO TO 900
  35. C--------------------------
  36. YLAMDA=SQRT(-QUATRE*P/TROIS)
  37. IF(ABS(P).LE.PETIT) GO TO 100
  38. ANG=XPI/DEUX
  39. AA=(Q*TROIS)/(YLAMDA*P)
  40. C--------------------------
  41. * IF(ABS(AA-UN).LE.1.D-14) GO TO 22
  42. IF(ABS(AA-UN).LE.1.D-14 .OR. AA.GE.UN) THEN
  43. * IF(AA.GE.UN)THEN
  44. *22 S1=YLAMDA
  45. S1=YLAMDA
  46. S2=-YLAMDA/DEUX
  47. S3=S2
  48. GOTO 101
  49. ENDIF
  50. C--------------------------
  51. * IF(ABS(UN+AA).LE.1.D-14)GOTO 23
  52. IF(ABS(UN+AA).LE.1.D-14 .OR. AA.LE.XUN)THEN
  53. * IF(AA.LE.XUN)THEN
  54. *23 S1=YLAMDA/DEUX
  55. S1=YLAMDA/DEUX
  56. S2=-YLAMDA
  57. S3=S1
  58. GOTO 101
  59. ENDIF
  60. C--------------------------
  61. AAA=ABS(AA)
  62. IF(AAA.GT.DM6)ANG=ACOS(AA)
  63. PHI=ANG/TROIS
  64. GO TO 200
  65. 100 CONTINUE
  66. PHI=XPI/DEUX
  67. C-------------------------
  68. 200 S1=YLAMDA*COS(PHI)
  69. S2=YLAMDA*COS(PHI+(XPI*DEUX)/TROIS)
  70. S3=YLAMDA*COS(PHI+(XPI*QUATRE)/TROIS)
  71. C-----------------------------------------------------------------------
  72. 101 CONTINUE
  73. SIG1=S1-A/TROIS
  74. SIG2=S2-A/TROIS
  75. SIG3=S3-A/TROIS
  76. GO TO 999
  77. C-----------------------------------------------------------------------
  78. C ERREURS
  79. C-----------------------------------------------------------------------
  80. 900 WRITE(10,2000)
  81. 2000 FORMAT(/,' ***** ERREUR DANS EQUA3D : 2 RACINES',
  82. * /,7X,'IMAGINAIRES POUR LE CALCUL DES CONTRAINTES PRINCIPALES')
  83. GO TO 999
  84. C
  85. C------ FIN
  86. C
  87. 999 RETURN
  88. END
  89.  
  90.  

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