Transition to NewIO
[u/mrichter/AliRoot.git] / MICROCERN / fint.F
1 *
2 * $Id$
3 *
4 * $Log$
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 *
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 *
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)
23 C
24 C   INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
25 C   MODIFIED BY B. SCHORR, 1.07.1982.
26 C
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
94 1000      FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6,
95      +              17H NOT WITHIN RANGE)
96           END