PDF/spdf/dbfint.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.2  1996/10/30 08:27:52  cernlib
   6 * Version 7.04
   7 *
   8 * Revision 1.1.1.1  1996/04/12 15:29:15  plothow
   9 * Version 7.01
  10 *
  11 *
  12 #include "pdf/pilot.h"
  13 #if defined(CERNLIB_SINGLE)
  14       FUNCTION DBFINT(NARG,ARG,NA,ENT,TABLE)
  15 #endif
  16 #if defined(CERNLIB_DOUBLE)
  17       DOUBLE PRECISION FUNCTION DBFINT(NARG,ARG,NA,ENT,TABLE)
  18 #endif
  19 #include "pdf/impdp.inc"
  20              INTEGER NA(NARG), INDEX(32)
  21 #include "pdf/expdp.inc"
  22      +       ARG(NARG),ENT(10),TABLE(10),WEIGHT(32)
  23       DATA ZEROD/0.D0/ONED/1.D0/
  24 C
  25            DBFINT =  ZEROD
  26            IF(NARG .LT. 1  .OR.  NARG .GT. 5)  RETURN
  27 C
  28            LMAX      =  0
  29            ISTEP     =  1
  30            KNOTS     =  1
  31            INDEX(1)  =  1
  32            WEIGHT(1) =  ONED
  33            DO 100    N  =  1, NARG
  34               X     =  ARG(N)
  35               NDIM  =  NA(N)
  36               LOCA  =  LMAX
  37               LMIN  =  LMAX + 1
  38               LMAX  =  LMAX + NDIM
  39               IF(NDIM .GT. 2)  GOTO 10
  40               IF(NDIM .EQ. 1)  GOTO 100
  41               H  =  X - ENT(LMIN)
  42               IF(H .EQ. ZEROD)  GOTO 90
  43               ISHIFT  =  ISTEP
  44               IF(X-ENT(LMIN+1) .EQ. ZEROD)  GOTO 21
  45               ISHIFT  =  0
  46               ETA     =  H / (ENT(LMIN+1) - ENT(LMIN))
  47               GOTO 30
  48    10         LOCB  =  LMAX + 1
  49    11         LOCC  =  (LOCA+LOCB) / 2
  50               IF(X-ENT(LOCC))  12, 20, 13
  51    12         LOCB  =  LOCC
  52               GOTO 14
  53    13         LOCA  =  LOCC
  54    14         IF(LOCB-LOCA .GT. 1)  GOTO 11
  55               LOCA    =  MIN ( MAX (LOCA,LMIN), LMAX-1 )
  56               ISHIFT  =  (LOCA - LMIN) * ISTEP
  57               ETA     =  (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA))
  58               GOTO 30
  59    20         ISHIFT  =  (LOCC - LMIN) * ISTEP
  60    21         DO 22  K  =  1, KNOTS
  61                  INDEX(K)  =  INDEX(K) + ISHIFT
  62    22            CONTINUE
  63               GOTO 90
  64    30         DO 31  K  =  1, KNOTS
  65                  INDEX(K)         =  INDEX(K) + ISHIFT
  66                  INDEX(K+KNOTS)   =  INDEX(K) + ISTEP
  67                  WEIGHT(K+KNOTS)  =  WEIGHT(K) * ETA
  68                  WEIGHT(K)        =  WEIGHT(K) - WEIGHT(K+KNOTS)
  69    31            CONTINUE
  70               KNOTS  =  2*KNOTS
  71    90         ISTEP  =  ISTEP * NDIM
  72   100         CONTINUE
  73            DO 200    K  =  1, KNOTS
  74               I  =  INDEX(K)
  75               DBFINT =  DBFINT + WEIGHT(K) * TABLE(I)
  76   200         CONTINUE
  77            RETURN
  78            END