Merging the VirtualMC branch to the main development branch (HEAD)
[u/mrichter/AliRoot.git] / MICROCERN / fint.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
b9d0a01d 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*
fe4da5cc 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)
17C
18C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
19C MODIFIED BY B. SCHORR, 1.07.1982.
20C
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
881000 FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6,
89 + 17H NOT WITHIN RANGE)
90 END