[u/mrichter/AliRoot.git] / MICROCERN / fint.F

*
* $Id$
*
* $Log$
* Revision 1.2.4.1  2002/11/26 16:46:57  hristov
* Merging NewIO with v3-09-04
*
* Revision 1.2  2002/10/14 14:57:10  hristov
* Merging the VirtualMC branch to the main development branch (HEAD)
*
* Revision 1.1.2.1  2002/07/11 17:14:48  alibrary
* Adding MICROCERN
*
* Revision 1.1.1.1  1999/05/18 15:55:33  fca
* AliRoot sources
*
* Revision 1.1.1.1  1996/02/15 17:48:36  mclareni
* Kernlib
*
*
#include "kernnum/pilot.h"
          FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE)
C
C   INTERPOLATION ROUTINE. AUTHOR C. LETERTRE.
C   MODIFIED BY B. SCHORR, 1.07.1982.
C
          INTEGER   NENT(9)
          REAL      ARG(9),   ENT(9),   TABLE(9)
          INTEGER   INDEX(32)
          REAL      WEIGHT(32)
          LOGICAL   MFLAG,    RFLAG
          FINT  =  0.
          IF(NARG .LT. 1  .OR.  NARG .GT. 5)  GOTO 300
          LMAX      =  0
          ISTEP     =  1
          KNOTS     =  1
          INDEX(1)  =  1
          WEIGHT(1) =  1.
          DO 100    N  =  1, NARG
             X     =  ARG(N)
             NDIM  =  NENT(N)
             LOCA  =  LMAX
             LMIN  =  LMAX + 1
             LMAX  =  LMAX + NDIM
             IF(NDIM .GT. 2)  GOTO 10
             IF(NDIM .EQ. 1)  GOTO 100
             H  =  X - ENT(LMIN)
             IF(H .EQ. 0.)  GOTO 90
             ISHIFT  =  ISTEP
             IF(X-ENT(LMIN+1) .EQ. 0.)  GOTO 21
             ISHIFT  =  0
             ETA     =  H / (ENT(LMIN+1) - ENT(LMIN))
             GOTO 30
  10         LOCB  =  LMAX + 1
  11         LOCC  =  (LOCA+LOCB) / 2
             IF(X-ENT(LOCC))  12, 20, 13
  12         LOCB  =  LOCC
             GOTO 14
  13         LOCA  =  LOCC
  14         IF(LOCB-LOCA .GT. 1)  GOTO 11
             LOCA    =  MIN0( MAX0(LOCA,LMIN), LMAX-1 )
             ISHIFT  =  (LOCA - LMIN) * ISTEP
             ETA     =  (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA))
             GOTO 30
  20         ISHIFT  =  (LOCC - LMIN) * ISTEP
  21         DO 22  K  =  1, KNOTS
                INDEX(K)  =  INDEX(K) + ISHIFT
  22            CONTINUE
             GOTO 90
  30         DO 31  K  =  1, KNOTS
                INDEX(K)         =  INDEX(K) + ISHIFT
                INDEX(K+KNOTS)   =  INDEX(K) + ISTEP
                WEIGHT(K+KNOTS)  =  WEIGHT(K) * ETA
                WEIGHT(K)        =  WEIGHT(K) - WEIGHT(K+KNOTS)
  31            CONTINUE
             KNOTS  =  2*KNOTS
  90         ISTEP  =  ISTEP * NDIM
 100         CONTINUE
          DO 200    K  =  1, KNOTS
             I  =  INDEX(K)
             FINT  =  FINT + WEIGHT(K) * TABLE(I)
 200         CONTINUE
          RETURN
 300      CALL KERMTR('E104.1',LGFILE,MFLAG,RFLAG)
          IF(MFLAG) THEN
             IF(LGFILE .EQ. 0) THEN
                WRITE(*,1000) NARG
             ELSE
                WRITE(LGFILE,1000) NARG
             ENDIF
          ENDIF
          IF(.NOT. RFLAG) CALL ABEND
          RETURN
1000      FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6,
     +              17H NOT WITHIN RANGE)
          END
Commit	Line	Data
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)
	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