Sources Esope | Cast3M

gamt3
C GAMT3     SOURCE    CHAT      05/01/13    00:15:41     5004
      SUBROUTINE GAMT3(S,DS,R3,YUNG,GAMA,KERRE)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC PPARAM
-INC CCOPTIO
C
      DIMENSION S(*),DS(*)
      RF=YUNG*YUNG*YUNG*1.D-24
      GAMRF=1.D-7
C
C***********************************************************************
C*********** CALCUL DES COEFICIENTS DE L EQUATION DU 3: DEGRE **********
C*********** AAA GAMA **3 + BBB GAMA **2 + CCC GAMA + DDD =0 ***********
C***********************************************************************
C
      AA1=DS(1)*DS(2)*DS(3)+2.D0*DS(4)*DS(5)*DS(6)
      AA2=DS(1)*DS(5)*DS(5)+DS(2)*DS(6)*DS(6)+DS(3)*DS(4)*DS(4)
      AAA=AA1-AA2
C
      BB1=DS(1)*DS(2)*R3+DS(2)*DS(3)*R3+DS(3)*DS(1)*R3
      BB2=DS(4)*DS(4)*R3+DS(5)*DS(5)*R3+DS(6)*DS(6)*R3
      BB3=S(1)*DS(5)*DS(5)+S(2)*DS(6)*DS(6)+S(3)*DS(4)*DS(4)
      BB4=S(1)*DS(2)*DS(3)+S(2)*DS(3)*DS(1)+S(3)*DS(1)*DS(2)
      BB5=S(4)*DS(5)*DS(6)+S(5)*DS(6)*DS(4)+S(6)*DS(4)*DS(5)
      BB6=S(4)*DS(4)*DS(3)+S(5)*DS(5)*DS(1)+S(6)*DS(6)*DS(2)
      BBB=-BB1+BB2-BB3+BB4+2.D0*BB5-2.D0*BB6
C
      CC1=DS(1)*R3*R3+DS(2)*R3*R3+DS(3)*R3*R3
      CC2=S(1)*DS(2)*R3+S(2)*DS(3)*R3+S(3)*DS(1)*R3
      CC3=S(1)*DS(3)*R3+S(2)*DS(1)*R3+S(3)*DS(2)*R3
      CC4=S(4)*DS(4)*R3+S(5)*DS(5)*R3+S(6)*DS(6)*R3
      CC5=S(1)*S(2)*DS(3)+S(2)*S(3)*DS(1)+S(3)*S(1)*DS(2)
      CC6=S(4)*S(4)*DS(3)+S(5)*S(5)*DS(1)+S(6)*S(6)*DS(2)
      CC7=S(4)*S(5)*DS(6)+S(5)*S(6)*DS(4)+S(6)*S(4)*DS(5)
      CC8=S(1)*S(5)*DS(5)+S(2)*S(6)*DS(6)+S(3)*S(4)*DS(4)
      CCC=CC1-CC2-CC3+2.D0*CC4+CC5-CC6+2.D0*CC7-2.D0*CC8
C
      DD1=-R3*R3*R3+S(1)*R3*R3+S(2)*R3*R3+S(3)*R3*R3
      DD2=S(4)*S(4)*R3+S(5)*S(5)*R3+S(6)*S(6)*R3
      DD3=S(1)*S(2)*R3+S(2)*S(3)*R3+S(3)*S(1)*R3
      DD4=S(1)*S(5)*S(5)+S(2)*S(6)*S(6)+S(3)*S(4)*S(4)
      DD5=S(1)*S(2)*S(3)+2.D0*S(4)*S(5)*S(6)
      DDD=DD1+DD2-DD3-DD4+DD5
C
      IF(IIMPI.EQ.9) THEN
        WRITE(6,*) 'AA1',AA1
        WRITE(6,*) 'AA2',AA2
        WRITE(6,*) 'AAA',AAA
        WRITE(6,*) '***********************************************'
C
        WRITE(6,*) 'BB1',BB1
        WRITE(6,*) 'BB2',BB2
        WRITE(6,*) 'BB3',BB3
        WRITE(6,*) 'BB4',BB4
        WRITE(6,*) 'BB5',BB5
        WRITE(6,*) 'BB6',BB6
        WRITE(6,*) 'BBB',BBB
        WRITE(6,*) '***********************************************'
C
        WRITE(6,*) 'CC1',CC1
        WRITE(6,*) 'CC2',CC2
        WRITE(6,*) 'CC3',CC3
        WRITE(6,*) 'CC4',CC4
        WRITE(6,*) 'CC5',CC5
        WRITE(6,*) 'CC6',CC6
        WRITE(6,*) 'CC7',CC7
        WRITE(6,*) 'CC8',CC8
        WRITE(6,*) 'CCC',CCC
        WRITE(6,*) '***********************************************'
C
        WRITE(6,*) 'DD1',DD1
        WRITE(6,*) 'DD2',DD2
        WRITE(6,*) 'DD3',DD3
        WRITE(6,*) 'DD4',DD4
        WRITE(6,*) 'DD5',DD5
        WRITE(6,*) 'DDD',DDD
        WRITE(6,*) '***********************************************'
C
      ENDIF
C
      IF(ABS(AAA).LT.RF) AAA=0.D0
      IF(ABS(BBB).LT.RF) BBB=0.D0
      IF(ABS(CCC).LT.RF) CCC=0.D0
      IF(ABS(DDD).LT.RF) DDD=0.D0
C
C***********************************************************************
C******* CALCUL DES RACINES REELLES DE L EQUATION DU 3: DEGRE **********
C***********************************************************************
C
      CALL RSEQ3D (AAA,BBB,CCC,DDD,YUNG,X1,X2,X3,KERRE)
      IF(KERRE.NE.0) RETURN
C
C***********************************************************************
C************** LA PLUS PETITE VALEUR DE GAMMA POSITIVE ****************
C***********************************************************************
C
      IF(ABS(X1).LE.GAMRF) X1=0.D0
      IF(ABS(X2).LE.GAMRF) X2=0.D0
      IF(ABS(X3).LE.GAMRF) X3=0.D0
      IF(X1.LT.0.D0) X1=1.D0
      IF(X2.LT.0.D0) X2=1.D0
      IF(X3.LT.0.D0) X3=1.D0
      GAMA=MIN(X1,X2,X3)
C
      RETURN
      END