Esope source files

   1 : C GAMDP     SOURCE    CHAT      05/01/13    00:15:26     5004           
   2 :       FUNCTION GAMDP(S,DS,ALF,R,IC,PREC,RFSG,RFEP,RFPR)
   3 : C
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 : -INC CCOPTIO
   7 : C
   8 :       DIMENSION S(*),DS(*)
   9 : C
  10 :       IF(IIMPI.EQ.9) WRITE(IOIMP,20) (S(I),I=1,6)
  11 :       IF(IIMPI.EQ.9) WRITE(IOIMP,21) (DS(I),I=1,6)
  12 :       IF(IIMPI.EQ.9) WRITE(IOIMP,22) ALF,R
  13 :       DSIEQ2=AVM(DS,DS)
  14 :       DSIEQ=SQRT(DSIEQ2)
  15 :       TRDSIG=DS(1)+DS(2)+DS(3)
  16 :       YY=DSIEQ2-ALF*ALF*TRDSIG*TRDSIG
  17 :       AA=AVM(S,DS)
  18 :       SIEQ02=AVM(S,S)
  19 :       TRSIG0=S(1)+S(2)+S(3)
  20 :       A2B=ALF*ALF*TRSIG0*TRDSIG
  21 :       XX=AA-A2B+ALF*R*TRDSIG
  22 :       ZZ2=(R-ALF*TRSIG0)**2
  23 :       IF(YY.EQ.0.D0) GO TO 1
  24 :       DELTA=XX*XX+YY*(ZZ2-SIEQ02)
  25 :       IF(IIMPI.EQ.9)
  26 :      .   WRITE(IOIMP,23) DSIEQ2,TRDSIG,YY,AA,SIEQ02,TRSIG0,A2B,
  27 :      .                   XX,ZZ2,DELTA
  28 :       VRF=MAX(ABS(XX),RFPR)
  29 :       RFRF=VRF*VRF*PREC*PREC
  30 :       IF(ABS(DELTA).LE.RFRF.AND.DELTA.LE.0.D0) DELTA=0.D0
  31 :       IF(DELTA.GE.0.D0) GO TO 2
  32 :       IF(IIMPI.EQ.9) WRITE(IOIMP,11)DELTA
  33 :       GAMDP=100.D0
  34 :       RETURN
  35 :     2 RADEL=SQRT(DELTA)
  36 :       GAMDP=(-XX+RADEL)/YY
  37 :       IF(IC.EQ.1)GAMDP=(-XX-RADEL)/YY
  38 :       RETURN
  39 :     1 CRITD=DSIEQ-ALF*TRDSIG
  40 :       IF(CRITD.EQ.0.D0) GO TO 3
  41 :       IF(XX.NE.0.D0) GO TO 4
  42 :       IF(R.EQ.0.D0) GO TO 5
  43 :       IF(IIMPI.EQ.9) WRITE(IOIMP,10)
  44 :       GAMDP=100.D0
  45 :       RETURN
  46 :     4 GAMDP=(ZZ2-SIEQ02)/(2.D0*XX)
  47 :       RETURN
  48 :    5  GAMDP=0.D0
  49 :       RETURN
  50 :    3  GAMDP=100.D0
  51 : C
  52 :    10 FORMAT(1X,'DANS GAMDP DETERMINANT EST NUL')
  53 :    11 FORMAT(1X,'DANS GAMDP DELTA EST NEGATIF DELTA =',1PD12.5)
  54 :    20 FORMAT(1X,'SIGMA =',6(1X,1PD12.5))
  55 :    21 FORMAT(1X,'DSIGMA=',6(1X,1PD12.5))
  56 :    22 FORMAT(1X,'ALFA  =',1PD12.5,1X,'R     =',1PD12.5)
  57 :    23 FORMAT(1X,'DSIEQ2=',1PD12.5,1X,'TRDSIG=',1PD12.5,
  58 :      .       1X,'YY    =',1PD12.5,1X,'AA    =',1PD12.5,/,
  59 :      .       1X,'SIEQ02=',1PD12.5,1X,'TRSIG0=',1PD12.5,
  60 :      .       1X,'A2B   =',1PD12.5,1X,'XX    =',1PD12.5,/,
  61 :      .       1X,'ZZ2   =',1PD12.5,1X,'DELTA =',1PD12.5)
  62 : C
  63 :       RETURN
  64 :       END
  65 :  
  66 :