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