* * $Id: fint.F,v 1.1.1.1 1996/02/15 17:53:26 mclareni Exp $ * * $Log: fint.F,v $ * Revision 1.1.1.1 1996/02/15 17:53:26 mclareni * Kernlib * * #include "sys/CERNLIB_machine.h" #include "pilot.h" FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE) C C CERN PROGLIB# E104 FINT .VERSION KERNFOR 4.02 820723 C ORIG. 09/08/65 CHL. C C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE. C MODIFIED BY B. SCHORR, 1.07.1982. C INTEGER NENT(NARG) REAL ARG(NARG),ENT(9), TABLE(9) INTEGER INDEX(32) REAL WEIGHT(32) FINT = 0. IF(NARG .LT. 1 .OR. NARG .GT. 5) RETURN LMAX = 0 ISTEP = 1 KNOTS = 1 INDEX(1) = 1 WEIGHT(1) = 1. DO 100 N = 1, NARG X = ARG(N) NDIM = NENT(N) LOCA = LMAX LMIN = LMAX + 1 LMAX = LMAX + NDIM IF(NDIM .GT. 2) GOTO 10 IF(NDIM .EQ. 1) GOTO 100 H = X - ENT(LMIN) IF(H .EQ. 0.) GOTO 90 ISHIFT = ISTEP IF(X-ENT(LMIN+1) .EQ. 0.) GOTO 21 ISHIFT = 0 ETA = H / (ENT(LMIN+1) - ENT(LMIN)) GOTO 30 10 LOCB = LMAX + 1 11 LOCC = (LOCA+LOCB) / 2 IF(X-ENT(LOCC)) 12, 20, 13 12 LOCB = LOCC GOTO 14 13 LOCA = LOCC 14 IF(LOCB-LOCA .GT. 1) GOTO 11 LOCA = MIN0( MAX0(LOCA,LMIN), LMAX-1 ) ISHIFT = (LOCA - LMIN) * ISTEP ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA)) GOTO 30 20 ISHIFT = (LOCC - LMIN) * ISTEP 21 DO 22 K = 1, KNOTS INDEX(K) = INDEX(K) + ISHIFT 22 CONTINUE GOTO 90 30 DO 31 K = 1, KNOTS INDEX(K) = INDEX(K) + ISHIFT INDEX(K+KNOTS) = INDEX(K) + ISTEP WEIGHT(K+KNOTS) = WEIGHT(K) * ETA WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS) 31 CONTINUE KNOTS = 2*KNOTS 90 ISTEP = ISTEP * NDIM 100 CONTINUE DO 200 K = 1, KNOTS I = INDEX(K) FINT = FINT + WEIGHT(K) * TABLE(I) 200 CONTINUE RETURN END