MICROCERN/fint.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.2.1  2002/07/11 17:14:48  alibrary
   6 * Adding MICROCERN
   7 *
   8 * Revision 1.1.1.1  1999/05/18 15:55:33  fca
   9 * AliRoot sources
  10 *
  11 * Revision 1.1.1.1  1996/02/15 17:48:36  mclareni
  12 * Kernlib
  13 *
  14 *
  15 #include "kernnum/pilot.h"
  16           FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE)
  17 C
  18 C   INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
  19 C   MODIFIED BY B. SCHORR, 1.07.1982.
  20 C
  21           INTEGER   NENT(9)
  22           REAL      ARG(9),   ENT(9),   TABLE(9)
  23           INTEGER   INDEX(32)
  24           REAL      WEIGHT(32)
  25           LOGICAL   MFLAG,    RFLAG
  26           FINT  =  0.
  27           IF(NARG .LT. 1  .OR.  NARG .GT. 5)  GOTO 300
  28           LMAX      =  0
  29           ISTEP     =  1
  30           KNOTS     =  1
  31           INDEX(1)  =  1
  32           WEIGHT(1) =  1.
  33           DO 100    N  =  1, NARG
  34              X     =  ARG(N)
  35              NDIM  =  NENT(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. 0.)  GOTO 90
  43              ISHIFT  =  ISTEP
  44              IF(X-ENT(LMIN+1) .EQ. 0.)  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    =  MIN0( MAX0(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              FINT  =  FINT + WEIGHT(K) * TABLE(I)
  76  200         CONTINUE
  77           RETURN
  78  300      CALL KERMTR('E104.1',LGFILE,MFLAG,RFLAG)
  79           IF(MFLAG) THEN
  80              IF(LGFILE .EQ. 0) THEN
  81                 WRITE(*,1000) NARG
  82              ELSE
  83                 WRITE(LGFILE,1000) NARG
  84              ENDIF
  85           ENDIF
  86           IF(.NOT. RFLAG) CALL ABEND
  87           RETURN
  88 1000      FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6,
  89      +              17H NOT WITHIN RANGE)
  90           END