1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
*DECK DETPOL
REAL FUNCTION DETPOL(VECT,IXX,JJJ,K0,I1,I2,I3,X1,X2,X3,X)
*
*----------------------------------------------------------------------
*Purpose:
* Function performing the parabolic interpolation at X.
*
*Author(s):
* M. Beaudet
*
*Parameters:
* DETPOL
* VECT
* IXX
* JJJ
* K0
* I1
* I2
* I3
* X1
* X2
* X3
* X
*
*----------------------------------------------------------------------
*
INTEGER*4 IXX(*)
REAL*4 VECT(*)
*
CHARACTER*6 CLNAME
DATA CLNAME /'INTPOL'/
*
IJK1 = IXX(JJJ+K0+I1)
IJK2 = IXX(JJJ+K0+I2)
IJK3 = IXX(JJJ+K0+I3)
*
IZERO = 0
*
IF (IJK1.LE.0) IZERO = IZERO + 1
IF (IJK2.LE.0) IZERO = IZERO + 1
IF (IJK3.LE.0) IZERO = IZERO + 1
*
IF (IZERO.GE.2) CALL XABORT('DETPOL: INVALID VALUE OF INDICES')
*
IF (IJK1.LE.0) THEN
A2 = VECT(IJK2)
A3 = VECT(IJK3)
CALL DETLIN(X2,X3,A2,A3,BE,CE)
AH = 0.0
*
ELSE IF (IJK2.LE.0) THEN
A1 = VECT(IJK1)
A3 = VECT(IJK3)
CALL DETLIN(X1,X3,A1,A3,BE,CE)
AH = 0.0
*
ELSE IF (IJK3.LE.0) THEN
A1 = VECT(IJK1)
A2 = VECT(IJK2)
CALL DETLIN(X1,X2,A1,A2,BE,CE)
AH = 0.0
*
ELSE
A1 = VECT(IJK1)
A2 = VECT(IJK2)
A3 = VECT(IJK3)
CALL DETPAR(X1,X2,X3,A1,A2,A3,AH,BE,CE)
ENDIF
*
DETPOL = AH*X*X + BE*X + CE
*
RETURN
END
|
