Transition to NewIO
[u/mrichter/AliRoot.git] / MICROCERN / fint.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
88cb7938 5* Revision 1.2.4.1 2002/11/26 16:46:57 hristov
6* Merging NewIO with v3-09-04
7*
8* Revision 1.2 2002/10/14 14:57:10 hristov
9* Merging the VirtualMC branch to the main development branch (HEAD)
10*
b9d0a01d 11* Revision 1.1.2.1 2002/07/11 17:14:48 alibrary
12* Adding MICROCERN
13*
14* Revision 1.1.1.1 1999/05/18 15:55:33 fca
15* AliRoot sources
16*
fe4da5cc 17* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni
18* Kernlib
19*
20*
21#include "kernnum/pilot.h"
22 FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE)
23C
24C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
25C MODIFIED BY B. SCHORR, 1.07.1982.
26C
27 INTEGER NENT(9)
28 REAL ARG(9), ENT(9), TABLE(9)
29 INTEGER INDEX(32)
30 REAL WEIGHT(32)
31 LOGICAL MFLAG, RFLAG
32 FINT = 0.
33 IF(NARG .LT. 1 .OR. NARG .GT. 5) GOTO 300
34 LMAX = 0
35 ISTEP = 1
36 KNOTS = 1
37 INDEX(1) = 1
38 WEIGHT(1) = 1.
39 DO 100 N = 1, NARG
40 X = ARG(N)
41 NDIM = NENT(N)
42 LOCA = LMAX
43 LMIN = LMAX + 1
44 LMAX = LMAX + NDIM
45 IF(NDIM .GT. 2) GOTO 10
46 IF(NDIM .EQ. 1) GOTO 100
47 H = X - ENT(LMIN)
48 IF(H .EQ. 0.) GOTO 90
49 ISHIFT = ISTEP
50 IF(X-ENT(LMIN+1) .EQ. 0.) GOTO 21
51 ISHIFT = 0
52 ETA = H / (ENT(LMIN+1) - ENT(LMIN))
53 GOTO 30
54 10 LOCB = LMAX + 1
55 11 LOCC = (LOCA+LOCB) / 2
56 IF(X-ENT(LOCC)) 12, 20, 13
57 12 LOCB = LOCC
58 GOTO 14
59 13 LOCA = LOCC
60 14 IF(LOCB-LOCA .GT. 1) GOTO 11
61 LOCA = MIN0( MAX0(LOCA,LMIN), LMAX-1 )
62 ISHIFT = (LOCA - LMIN) * ISTEP
63 ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA))
64 GOTO 30
65 20 ISHIFT = (LOCC - LMIN) * ISTEP
66 21 DO 22 K = 1, KNOTS
67 INDEX(K) = INDEX(K) + ISHIFT
68 22 CONTINUE
69 GOTO 90
70 30 DO 31 K = 1, KNOTS
71 INDEX(K) = INDEX(K) + ISHIFT
72 INDEX(K+KNOTS) = INDEX(K) + ISTEP
73 WEIGHT(K+KNOTS) = WEIGHT(K) * ETA
74 WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS)
75 31 CONTINUE
76 KNOTS = 2*KNOTS
77 90 ISTEP = ISTEP * NDIM
78 100 CONTINUE
79 DO 200 K = 1, KNOTS
80 I = INDEX(K)
81 FINT = FINT + WEIGHT(K) * TABLE(I)
82 200 CONTINUE
83 RETURN
84 300 CALL KERMTR('E104.1',LGFILE,MFLAG,RFLAG)
85 IF(MFLAG) THEN
86 IF(LGFILE .EQ. 0) THEN
87 WRITE(*,1000) NARG
88 ELSE
89 WRITE(LGFILE,1000) NARG
90 ENDIF
91 ENDIF
92 IF(.NOT. RFLAG) CALL ABEND
93 RETURN
941000 FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6,
95 + 17H NOT WITHIN RANGE)
96 END