C EQUAT3    SOURCE    CB215821  16/04/22    21:15:02     8922           
      SUBROUTINE EQUAT3(A,B,C,SIG1,SIG2,SIG3)
C=======================================================================
C
C         RESOLUTION D'UNE EQUATION DU 3EME DEGRE DE LA FORME:
C                   X*X*X + A*X*X + B*X + C = 0
C
C=======================================================================
C
C  ENTREES: A , B , C.
C  SORTIES: SIG1 , SIG2 , SIG3.
C
C=======================================================================
C
C  CREATION : F.CORMERY
C             E.N.S.M.A - LMPM
C             DEC 1992
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

      DATA DEUX/2.D0/,TROIS/3.D0/,QUATRE/4.D0/,DM6/1.D-8/,PETIT/1.D-12/
      DATA A27/27.D0/,UN/1.D0/,XUN/-1.D0/

-INC CCREEL

C-----------------------------------------------------------------------
      P=B-A*A/TROIS
      Q=(DEUX*A*A*A/A27)-((A*B)/TROIS)+C
      XIMAGI=(QUATRE*P*P*P)+A27*Q*Q
      AXIMAG=ABS(XIMAGI)
C--------------------------
      IF(XIMAGI.GT.XZERO.AND.AXIMAG.GT.DM6) GO TO 900
C--------------------------
      YLAMDA=SQRT(-QUATRE*P/TROIS)
      IF(ABS(P).LE.PETIT) GO TO 100
      ANG=XPI/DEUX
      AA=(Q*TROIS)/(YLAMDA*P)
C--------------------------
*      IF(ABS(AA-UN).LE.1.D-14) GO TO 22
      IF(ABS(AA-UN).LE.1.D-14 .OR. AA.GE.UN) THEN
*      IF(AA.GE.UN)THEN
*22    S1=YLAMDA
      S1=YLAMDA
      S2=-YLAMDA/DEUX
      S3=S2
      GOTO 101
      ENDIF
C--------------------------
*      IF(ABS(UN+AA).LE.1.D-14)GOTO 23
      IF(ABS(UN+AA).LE.1.D-14 .OR. AA.LE.XUN)THEN
*      IF(AA.LE.XUN)THEN
*23    S1=YLAMDA/DEUX
      S1=YLAMDA/DEUX
      S2=-YLAMDA
      S3=S1
      GOTO 101
      ENDIF
C--------------------------
      AAA=ABS(AA)
      IF(AAA.GT.DM6)ANG=ACOS(AA)
      PHI=ANG/TROIS
      GO TO 200
100   CONTINUE
      PHI=XPI/DEUX
C-------------------------
200   S1=YLAMDA*COS(PHI)
      S2=YLAMDA*COS(PHI+(XPI*DEUX)/TROIS)
      S3=YLAMDA*COS(PHI+(XPI*QUATRE)/TROIS)
C-----------------------------------------------------------------------
101   CONTINUE
      SIG1=S1-A/TROIS
      SIG2=S2-A/TROIS
      SIG3=S3-A/TROIS
      GO TO 999
C-----------------------------------------------------------------------
C                             ERREURS
C-----------------------------------------------------------------------
900   WRITE(10,2000)
2000  FORMAT(/,' ***** ERREUR DANS EQUA3D :  2 RACINES',
     *    /,7X,'IMAGINAIRES POUR LE CALCUL DES CONTRAINTES PRINCIPALES')
      GO TO 999
C
C------ FIN
C
999   RETURN
      END
 
