Esope source files

   1 : C EQUAT3    SOURCE    CHAT      05/01/12    23:44:32     5004           
   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 :       DATA DEUX/2.D0/,TROIS/3.D0/,QUATRE/4.D0/,DM6/1.D-8/,PETIT/1.D-12/
  23 :       DATA A27/27.D0/,UN/1.D0/,XUN/-1.D0/
  24 : C-----------------------------------------------------------------------
  25 :       COS(X)=DCOS(X)
  26 :       ACOS(X)=DACOS(X)
  27 :       PI=DATAN(1.D0)*4.D0
  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.0.D0.AND.AXIMAG.GT.DM6) GO TO 900
  35 : C--------------------------
  36 :       R=-QUATRE*P/TROIS
  37 :       YLAMDA=SQRT(R)
  38 :       IF(ABS(P).LE.PETIT) GO TO 100
  39 :       ANG=PI/DEUX
  40 :       AA=(Q*TROIS)/(YLAMDA*P)
  41 : C--------------------------
  42 : *      IF(ABS(AA-UN).LE.1.E-14) GO TO 22
  43 :       IF(ABS(AA-UN).LE.1.E-14.OR.AA.GE.UN) THEN
  44 : *      IF(AA.GE.UN)THEN
  45 : *22    S1=YLAMDA
  46 :       S1=YLAMDA
  47 :       S2=-YLAMDA/2
  48 :       S3=S2
  49 :       GOTO 101
  50 :       ENDIF
  51 : C--------------------------
  52 : *      IF(ABS(UN+AA).LE.1.E-14)GOTO 23
  53 :       IF(ABS(UN+AA).LE.1.E-14.OR.AA.LE.XUN)THEN
  54 : *      IF(AA.LE.XUN)THEN
  55 : *23    S1=YLAMDA/2
  56 :       S1=YLAMDA/2
  57 :       S2=-YLAMDA
  58 :       S3=S1
  59 :       GOTO 101
  60 :       ENDIF
  61 : C--------------------------
  62 :       AAA=ABS(AA)
  63 :       IF(AAA.GT.DM6)ANG=ACOS(AA)
  64 :       PHI=ANG/TROIS
  65 :       GO TO 200
  66 : 100   CONTINUE
  67 :       PHI=PI/DEUX
  68 : C-------------------------
  69 : 200   S1=YLAMDA*COS(PHI)
  70 :       S2=YLAMDA*COS(PHI+(PI*DEUX)/TROIS)
  71 :       S3=YLAMDA*COS(PHI+(PI*QUATRE)/TROIS)
  72 : C-----------------------------------------------------------------------
  73 : 101   CONTINUE
  74 :       SIG1=S1-A/TROIS
  75 :       SIG2=S2-A/TROIS
  76 :       SIG3=S3-A/TROIS
  77 :       GO TO 999
  78 : C-----------------------------------------------------------------------
  79 : C                             ERREURS
  80 : C-----------------------------------------------------------------------
  81 : 900   WRITE(10,2000) 
  82 : 2000  FORMAT(/,' ***** ERREUR DANS EQUA3D :  2 RACINES',
  83 :      *    /,7X,'IMAGINAIRES POUR LE CALCUL DES CONTRAINTES PRINCIPALES')
  84 :       GO TO 999
  85 : C
  86 : C------ FIN
  87 : C
  88 : 999   RETURN
  89 :       END
  90 :  
  91 :