Added check for floating exception in TParticle->Eta() and support for various Eventh...
[u/mrichter/AliRoot.git] / MICROCERN / fint.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
fe4da5cc 4#include "kernnum/pilot.h"
5 FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE)
6C
7C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
8C MODIFIED BY B. SCHORR, 1.07.1982.
9C
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
771000 FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6,
78 + 17H NOT WITHIN RANGE)
79 END