]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
fe4da5cc | 4 | #include "kernnum/pilot.h" |
5 | FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE) | |
6 | C | |
7 | C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE. | |
8 | C MODIFIED BY B. SCHORR, 1.07.1982. | |
9 | C | |
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 | |
77 | 1000 FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6, | |
78 | + 17H NOT WITHIN RANGE) | |
79 | END |