PDF/spdf/augetfv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.2  1996/10/30 08:27:34  cernlib
   6 * Version 7.04
   7 *
   8 * Revision 1.1.1.1  1996/04/12 15:29:02  plothow
   9 * Version 7.01
  10 *
  11 *
  12 #include "pdf/pilot.h"
  13 C
  14       FUNCTION AUGETFV(X,FVL)
  15 C  LOGARITHMIC INTERPOLATOR - WATCH OUT FOR NEGATIVE
  16 C  FUNCTIONS AND/OR X VALUES OUTSIDE THE RANGE 0 TO 1.
  17 C  NOTE: DIMENSION OF FVL IS OVERWRITTEN BY VALUE USED
  18 C  IN MAIN ROUTINE.
  19       DIMENSION FVL(25),XGRID(25)
  20       DATA NX,XGRID/25,.001,.002,.004,.008,.016,.032,.064,.1,.15,
  21      *.2,.25,.3,.35,.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95/
  22       AUGETFV=0.
  23       DO 1 I=1,NX
  24       IF(X.LT.XGRID(I)) GO TO 2
  25     1 CONTINUE
  26     2 I=I-1
  27       IF(I.EQ.0) THEN
  28          I=I+1
  29       ELSE IF(I.GT.23) THEN
  30          I=23
  31       ENDIF
  32       J=I+1
  33       K=J+1
  34       AXI= LOG(XGRID(I))
  35       BXI= LOG(1.-XGRID(I))
  36       AXJ= LOG(XGRID(J))
  37       BXJ= LOG(1.-XGRID(J))
  38       AXK= LOG(XGRID(K))
  39       BXK= LOG(1.-XGRID(K))
  40       FI= LOG(ABS(FVL(I)) +1.E-15)
  41       FJ= LOG(ABS(FVL(J)) +1.E-16)
  42       FK= LOG(ABS(FVL(K)) +1.E-17)
  43       DET=AXI*(BXJ-BXK)+AXJ*(BXK-BXI)+AXK*(BXI-BXJ)
  44       ALOGA=(FI*(AXJ*BXK-AXK*BXJ)+FJ*(AXK*BXI-AXI*BXK)+FK*(AXI*BXJ-AXJ*
  45      $ BXI))/DET
  46       ALPHA=(FI*(BXJ-BXK)+FJ*(BXK-BXI)+FK*(BXI-BXJ))/DET
  47       BETA=(FI*(AXK-AXJ)+FJ*(AXI-AXK)+FK*(AXJ-AXI))/DET
  48       IF(ABS(ALPHA).GT.99..OR.ABS(BETA).GT.99..OR.ABS(ALOGA).GT.99.)
  49      1RETURN
  50 C      IF(ALPHA.GT.50..OR.BETA.GT.50.) THEN
  51 C         WRITE(6,2001) X,FVL
  52 C 2001    FORMAT(8E12.4)
  53 C         WRITE(6,2001) ALPHA,BETA,ALOGA,DET
  54 C      ENDIF
  55       AUGETFV=EXP(ALOGA)*X**ALPHA*(1.-X)**BETA
  56       RETURN
  57       END