MICROCERN/fint.F

   1 *
   2 * $Id$
   3 *
   4 #include "kernnum/pilot.h"
   5           FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE)
   6 C
   7 C   INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
   8 C   MODIFIED BY B. SCHORR, 1.07.1982.
   9 C
  10           INTEGER   NENT(9)
  11           REAL      ARG(9),   ENT(9),   TABLE(9)
  12           INTEGER   INDEX(32)
  13           REAL      WEIGHT(32)
  14           LOGICAL   MFLAG,    RFLAG
  15           FINT  =  0.
  16           IF(NARG .LT. 1  .OR.  NARG .GT. 5)  GOTO 300
  17           LMAX      =  0
  18           ISTEP     =  1
  19           KNOTS     =  1
  20           INDEX(1)  =  1
  21           WEIGHT(1) =  1.
  22           DO 100    N  =  1, NARG
  23              X     =  ARG(N)
  24              NDIM  =  NENT(N)
  25              LOCA  =  LMAX
  26              LMIN  =  LMAX + 1
  27              LMAX  =  LMAX + NDIM
  28              IF(NDIM .GT. 2)  GOTO 10
  29              IF(NDIM .EQ. 1)  GOTO 100
  30              H  =  X - ENT(LMIN)
  31              IF(H .EQ. 0.)  GOTO 90
  32              ISHIFT  =  ISTEP
  33              IF(X-ENT(LMIN+1) .EQ. 0.)  GOTO 21
  34              ISHIFT  =  0
  35              ETA     =  H / (ENT(LMIN+1) - ENT(LMIN))
  36              GOTO 30
  37   10         LOCB  =  LMAX + 1
  38   11         LOCC  =  (LOCA+LOCB) / 2
  39              IF(X-ENT(LOCC))  12, 20, 13
  40   12         LOCB  =  LOCC
  41              GOTO 14
  42   13         LOCA  =  LOCC
  43   14         IF(LOCB-LOCA .GT. 1)  GOTO 11
  44              LOCA    =  MIN0( MAX0(LOCA,LMIN), LMAX-1 )
  45              ISHIFT  =  (LOCA - LMIN) * ISTEP
  46              ETA     =  (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA))
  47              GOTO 30
  48   20         ISHIFT  =  (LOCC - LMIN) * ISTEP
  49   21         DO 22  K  =  1, KNOTS
  50                 INDEX(K)  =  INDEX(K) + ISHIFT
  51   22            CONTINUE
  52              GOTO 90
  53   30         DO 31  K  =  1, KNOTS
  54                 INDEX(K)         =  INDEX(K) + ISHIFT
  55                 INDEX(K+KNOTS)   =  INDEX(K) + ISTEP
  56                 WEIGHT(K+KNOTS)  =  WEIGHT(K) * ETA
  57                 WEIGHT(K)        =  WEIGHT(K) - WEIGHT(K+KNOTS)
  58   31            CONTINUE
  59              KNOTS  =  2*KNOTS
  60   90         ISTEP  =  ISTEP * NDIM
  61  100         CONTINUE
  62           DO 200    K  =  1, KNOTS
  63              I  =  INDEX(K)
  64              FINT  =  FINT + WEIGHT(K) * TABLE(I)
  65  200         CONTINUE
  66           RETURN
  67  300      CALL KERMTR('E104.1',LGFILE,MFLAG,RFLAG)
  68           IF(MFLAG) THEN
  69              IF(LGFILE .EQ. 0) THEN
  70                 WRITE(*,1000) NARG
  71              ELSE
  72                 WRITE(LGFILE,1000) NARG
  73              ENDIF
  74           ENDIF
  75           IF(.NOT. RFLAG) CALL ABEND
  76           RETURN
  77 1000      FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6,
  78      +              17H NOT WITHIN RANGE)
  79           END