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