V3FIT
pc1ev.f
1  subroutine pc1ev(xget,x,nx,ilinx,f,ict,fval,ier)
2 C
3 C evaluate a 1d piecewise linear interpolant -- this is C0.
4 C ...a derivative can be evaluated but it is not continuous.
5 C
6 C this subroutine calls two subroutines:
7 C herm1x -- find cell containing (xget,yget)
8 C pc1fcn -- evaluate interpolant function and (optionally) derivatives
9 C
10 C input arguments:
11 C ================
12 C
13  real xget ! target of this interpolation
14  real x(nx) ! ordered x grid
15  integer ilinx ! ilinx=1 => assume x evenly spaced
16 C
17  real f(nx) ! function data
18 C
19 C contents of f:
20 C
21 C f(i) = f @ x(i)
22 C
23  integer ict(2) ! code specifying output desired
24 C
25 C ict(1)=1 -- return f (0, don't)
26 C ict(2)=1 -- return df/dx (0, don't)
27 C
28 C output arguments:
29 C =================
30 C
31  real fval(*) ! output data
32  integer ier ! error code =0 ==> no error
33 C
34 C fval(1) receives the first output (depends on ict(...) spec)
35 C fval(2) receives the second output (depends on ict(...) spec)
36 C
37 C examples:
38 C on input ict = [1,1]
39 C on output fval= [f,df/dx]
40 C
41 C on input ict = [1,0]
42 C on output fval= [f] ... element 2 never referenced
43 C
44 C on input ict = [0,1]
45 C on output fval= [df/dx] ... element 2 never referenced
46 C
47 C ier -- completion code: 0 means OK
48 C-------------------
49 C local:
50 C
51  integer :: i=0 ! cell index
52 c
53 C normalized displacement from (x(i)) corner of cell.
54 C xparam=0 @x(i) xparam=1 @x(i+1)
55 C
56  real xparam
57 C
58 C cell dimensions and
59 C inverse cell dimensions hxi = 1/(x(i+1)-x(i))
60 C
61  real hx
62  real hxi
63 C
64 C 0 .le. xparam .le. 1
65 C
66 C---------------------------------------------------------------------
67 C
68  call herm1x(xget,x,nx,ilinx,i,xparam,hx,hxi,ier)
69  if(ier.ne.0) return
70 c
71  call pc1fcn(ict,1,1,fval,i,xparam,hx,hxi,f,nx)
72 C
73  return
74  end
75 C---------------------------------------------------------------------
76 C evaluate C0 piecewise linear function interpolation -- 1d fcn
77 C --vectorized-- dmc 10 Feb 1999
78 C
79  subroutine pc1fcn(ict,ivec,ivecd,
80  > fval,ii,xparam,hx,hxi,fin,nx)
81 C
82 C input:
83 C
84  integer ict(2) ! requested output control
85  integer ivec ! vector length
86  integer ivecd ! vector dimension (1st dim of fval)
87 C
88  integer ii(ivec) ! target cells
89  real xparam(ivec)
90  ! normalized displacements in cells
91 C
92  real hx(ivec) ! grid spacing, and
93  real hxi(ivec) ! inverse grid spacing 1/(x(i+1)-x(i))
94 C
95  real fin(nx) ! the data
96 C
97 C output:
98 C
99  real fval(ivecd,*) ! interpolation results
100 C
101 C for detailed description of fin, ict and fval see subroutine
102 C pc1ev comments. Note ict is not vectorized -- the same output
103 C is expected to be returned for all input vector data points.
104 C
105 C note that the index inputs ii, and parameter inputs
106 C xparam,hx,hxi,are vectorized, and the
107 C
108 C output array fval has a vector ** 1st dimension ** whose
109 C size must be given as a separate argument; ivecd.ge.ivec
110 C expected!
111 C
112 C to use this routine in scalar mode, pass in ivec=ivecd=1
113 C
114 C---------------
115 C
116  integer v
117 C
118  do v=1,ivec
119  i=ii(v)
120  xp=xparam(v)
121  xpi=1.0-xp
122 C
123  iadr=0
124 C
125 C get desired values:
126 C
127  if(ict(1).eq.1) then
128 C
129 C function value:
130 C
131  iadr=iadr+1
132  fval(v,iadr)=xpi*fin(i)+xp*fin(i+1)
133 C
134  endif
135 C
136  if(ict(2).eq.1) then
137 C
138 C df/dx:
139 C
140  iadr=iadr+1
141 C
142  fval(v,iadr)=(fin(i+1)-fin(i))*hxi(v)
143  endif
144 C
145  enddo ! vector loop
146 C
147  return
148  end
Generated on Thu Mar 5 2020 15:49:24 for V3FIT by   doxygen 1.8.17