Télécharger la plaquette Cast3M


fr en

Télécharger equat3.eso

Retour à la liste

Numérotation des lignes : 

equat3

  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