Sources Esope | Cast3M

gamdp
C GAMDP     SOURCE    CHAT      05/01/13    00:15:26     5004
      FUNCTION GAMDP(S,DS,ALF,R,IC,PREC,RFSG,RFEP,RFPR)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C
      DIMENSION S(*),DS(*)
C
      IF(IIMPI.EQ.9) WRITE(IOIMP,20) (S(I),I=1,6)
      IF(IIMPI.EQ.9) WRITE(IOIMP,21) (DS(I),I=1,6)
      IF(IIMPI.EQ.9) WRITE(IOIMP,22) ALF,R
      DSIEQ2=AVM(DS,DS)
      DSIEQ=SQRT(DSIEQ2)
      TRDSIG=DS(1)+DS(2)+DS(3)
      YY=DSIEQ2-ALF*ALF*TRDSIG*TRDSIG
      AA=AVM(S,DS)
      SIEQ02=AVM(S,S)
      TRSIG0=S(1)+S(2)+S(3)
      A2B=ALF*ALF*TRSIG0*TRDSIG
      XX=AA-A2B+ALF*R*TRDSIG
      ZZ2=(R-ALF*TRSIG0)**2
      IF(YY.EQ.0.D0) GO TO 1
      DELTA=XX*XX+YY*(ZZ2-SIEQ02)
      IF(IIMPI.EQ.9)
     .   WRITE(IOIMP,23) DSIEQ2,TRDSIG,YY,AA,SIEQ02,TRSIG0,A2B,
     .                   XX,ZZ2,DELTA
      VRF=MAX(ABS(XX),RFPR)
      RFRF=VRF*VRF*PREC*PREC
      IF(ABS(DELTA).LE.RFRF.AND.DELTA.LE.0.D0) DELTA=0.D0
      IF(DELTA.GE.0.D0) GO TO 2
      IF(IIMPI.EQ.9) WRITE(IOIMP,11)DELTA
      GAMDP=100.D0
      RETURN
    2 RADEL=SQRT(DELTA)
      GAMDP=(-XX+RADEL)/YY
      IF(IC.EQ.1)GAMDP=(-XX-RADEL)/YY
      RETURN
    1 CRITD=DSIEQ-ALF*TRDSIG
      IF(CRITD.EQ.0.D0) GO TO 3
      IF(XX.NE.0.D0) GO TO 4
      IF(R.EQ.0.D0) GO TO 5
      IF(IIMPI.EQ.9) WRITE(IOIMP,10)
      GAMDP=100.D0
      RETURN
    4 GAMDP=(ZZ2-SIEQ02)/(2.D0*XX)
      RETURN
   5  GAMDP=0.D0
      RETURN
   3  GAMDP=100.D0
C
   10 FORMAT(1X,'DANS GAMDP DETERMINANT EST NUL')
   11 FORMAT(1X,'DANS GAMDP DELTA EST NEGATIF DELTA =',1PD12.5)
   20 FORMAT(1X,'SIGMA =',6(1X,1PD12.5))
   21 FORMAT(1X,'DSIGMA=',6(1X,1PD12.5))
   22 FORMAT(1X,'ALFA  =',1PD12.5,1X,'R     =',1PD12.5)
   23 FORMAT(1X,'DSIEQ2=',1PD12.5,1X,'TRDSIG=',1PD12.5,
     .       1X,'YY    =',1PD12.5,1X,'AA    =',1PD12.5,/,
     .       1X,'SIEQ02=',1PD12.5,1X,'TRSIG0=',1PD12.5,
     .       1X,'A2B   =',1PD12.5,1X,'XX    =',1PD12.5,/,
     .       1X,'ZZ2   =',1PD12.5,1X,'DELTA =',1PD12.5)
C
      RETURN
      END