V3FIT
pc2ev.f
1  subroutine pc2ev(xget,yget,x,nx,y,ny,ilinx,iliny,
2  > f,inf2,ict,fval,ier)
3 C
4 C evaluate a piecewise bilinear interpolant on a rectilinear
5 C grid -- this is C1 in both directions.
6 C
7 C this subroutine calls two subroutines:
8 C herm2xy -- find cell containing (xget,yget)
9 C pc2fcn -- evaluate interpolant function and (optionally) derivatives
10 C
11 C input arguments:
12 C ================
13 C
14  real xget,yget ! target of this interpolation
15  real x(nx) ! ordered x grid
16  real y(ny) ! ordered y grid
17  integer ilinx ! ilinx=1 => assume x evenly spaced
18  integer iliny ! iliny=1 => assume y evenly spaced
19 C
20  real f(inf2,ny) ! function data
21 C
22 C f 2nd dimension inf2 must be .ge. nx
23 C contents of f:
24 C
25 C f(i,j) = f @ x(i),y(j)
26 C
27  integer ict(4) ! code specifying output desired
28 C
29 C ict(1)=1 -- return f (0, don't)
30 C ict(2)=1 -- return df/dx (0, don't)
31 C ict(3)=1 -- return df/dy (0, don't)
32 C ict(4)=1 -- return d2f/dxdy (0, don't)
33 C
34 C output arguments:
35 C =================
36 C
37  real fval(*) ! output data
38  integer ier ! error code =0 ==> no error
39 C
40 C fval(1) receives the first output (depends on ict(...) spec)
41 C fval(2) receives the second output (depends on ict(...) spec)
42 C fval(3) receives the third output (depends on ict(...) spec)
43 C fval(4) receives the fourth output (depends on ict(...) spec)
44 C
45 C examples:
46 C on input ict = [1,1,1,1]
47 C on output fval= [f,df/dx,df/dy,d2f/dxdy]
48 C
49 C on input ict = [1,0,0,0]
50 C on output fval= [f] ... elements 2 & 3 & 4 never referenced
51 C
52 C on input ict = [0,1,1,0]
53 C on output fval= [df/dx,df/dy] ... element 3 & 4 never referenced
54 C
55 C on input ict = [0,0,1,0]
56 C on output fval= [df/dy] ... elements 2 & 3 & 4 never referenced.
57 C
58 C ier -- completion code: 0 means OK
59 C-------------------
60 C local:
61 C
62  integer i,j ! cell indices
63 C
64 C normalized displacement from (x(i),y(j)) corner of cell.
65 C xparam=0 @x(i) xparam=1 @x(i+1)
66 C yparam=0 @y(j) yparam=1 @y(j+1)
67 C
68  real xparam,yparam
69 C
70 C cell dimensions and
71 C inverse cell dimensions hxi = 1/(x(i+1)-x(i)), hyi = 1/(y(j+1)-y(j))
72 C
73  real hx,hy
74  real hxi,hyi
75 C
76 C 0 .le. xparam .le. 1
77 C 0 .le. yparam .le. 1
78 C
79 C---------------------------------------------------------------------
80 C
81  call herm2xy(xget,yget,x,nx,y,ny,ilinx,iliny,
82  > i,j,xparam,yparam,hx,hxi,hy,hyi,ier)
83  if(ier.ne.0) return
84 c
85  call pc2fcn(ict,1,1,
86  > fval,i,j,xparam,yparam,hx,hxi,hy,hyi,f,inf2,ny)
87 C
88  return
89  end
90 C---------------------------------------------------------------------
91 C evaluate piecewise bilinear function interpolation -- 2d fcn
92 C --vectorized-- dmc 10 Feb 1999
93 C
94  subroutine pc2fcn(ict,ivec,ivecd,
95  > fval,ii,jj,xparam,yparam,hx,hxi,hy,hyi,
96  > fin,inf2,ny)
97 C
98  integer ict(4) ! requested output control
99  integer ivec ! vector length
100  integer ivecd ! vector dimension (1st dim of fval)
101 C
102  integer ii(ivec),jj(ivec) ! target cells (i,j)
103  real xparam(ivec),yparam(ivec)
104  ! normalized displacements from (i,j) corners
105 C
106  real hx(ivec),hy(ivec) ! grid spacing, and
107  real hxi(ivec),hyi(ivec) ! inverse grid spacing 1/(x(i+1)-x(i))
108  ! & 1/(y(j+1)-y(j))
109 C
110  real fin(inf2,ny) ! interpolant data (cf "pc2ev")
111 C
112  real fval(ivecd,*) ! output returned
113 C
114 C for detailed description of fin, ict and fval see subroutine
115 C pc2ev comments. Note ict is not vectorized; the same output
116 C is expected to be returned for all input vector data points.
117 C
118 C note that the index inputs ii,jj and parameter inputs
119 C xparam,yparam,hx,hxi,hy,hyi are vectorized, and the
120 C output array fval has a vector ** 1st dimension ** whose
121 C size must be given as a separate argument
122 C
123 C to use this routine in scalar mode, pass in ivec=ivecd=1
124 C
125 C---------------
126 C
127  real sum
128  integer v
129 C
130 C ...in x direction
131 C
132  do v=1,ivec
133  i=ii(v)
134  j=jj(v)
135 c
136  xp=xparam(v)
137  xpi=1.0-xp
138 C
139 C ...in y direction
140 C
141  yp=yparam(v)
142  ypi=1.0-yp
143 C
144  iadr=0
145 C
146 C get desired values:
147 C
148  if(ict(1).eq.1) then
149 C
150 C function value:
151 C
152  iadr=iadr+1
153  sum=ypi*(xpi*fin(i,j)+xp*fin(i+1,j))
154  > + yp*(xpi*fin(i,j+1)+xp*fin(i+1,j+1))
155 C
156  fval(v,iadr)=sum
157  endif
158 C
159  if(ict(2).eq.1) then
160 C
161 C df/dx:
162 C
163  iadr=iadr+1
164 C
165  sum=ypi*(fin(i+1,j)-fin(i,j))
166  > + yp*(fin(i+1,j+1)-fin(i,j+1))
167  fval(v,iadr)=sum*hxi(v)
168 C
169  endif
170 C
171  if(ict(3).eq.1) then
172 C
173 C df/dy:
174 C
175  iadr=iadr+1
176 C
177  sum=xpi*(fin(i,j+1)-fin(i,j))
178  > + xp*(fin(i+1,j+1)-fin(i+1,j))
179  fval(v,iadr)=sum*hyi(v)
180  endif
181 C
182  if(ict(4).eq.1) then
183 C
184 C d2f/dxdy:
185 C
186  iadr=iadr+1
187 C
188  sum=fin(i+1,j+1)-fin(i,j+1)-fin(i+1,j)+fin(i,j)
189  fval(v,iadr)=sum*hxi(v)*hyi(v)
190  endif
191 C
192  enddo ! vector loop
193 C
194  return
195  end
196 C---------------------------------------------------------------------
197 C evaluate piecewise bilinear function interpolation -- 2d fcn
198 C --vectorized-- dmc 10 Feb 1999
199 C --optimized for VARIATION along x axis ONLY--
200 C
201  subroutine pc2fcnx(ict,ivec,ivecd,
202  > fval,ii,jj,xparam,yparam,hx,hxi,hy,hyi,
203  > fin,inf2,ny)
204 C
205  integer ict(4) ! requested output control
206  integer ivec ! vector length
207  integer ivecd ! vector dimension (1st dim of fval)
208 C
209  integer ii(ivec),jj ! target cells (i,j)
210  real xparam(ivec),yparam
211  ! normalized displacements from (i,j) corners
212 C
213  real hx(ivec),hy ! grid spacing, and
214  real hxi(ivec),hyi ! inverse grid spacing 1/(x(i+1)-x(i))
215  ! & 1/(y(j+1)-y(j))
216 C
217  real fin(inf2,ny) ! interpolant data (cf "pc2ev")
218 C
219  real fval(ivecd,*) ! output returned
220 C
221 C for detailed description of fin, ict and fval see subroutine
222 C pc2ev comments. Note ict is not vectorized; the same output
223 C is expected to be returned for all input vector data points.
224 C
225 C note that the index inputs ii,jj and parameter inputs
226 C xparam,yparam,hx,hxi,hy,hyi are vectorized, and the
227 C output array fval has a vector ** 1st dimension ** whose
228 C size must be given as a separate argument
229 C
230 C to use this routine in scalar mode, pass in ivec=ivecd=1
231 C
232 C---------------
233 C
234  real sum
235  integer v
236 C
237 C ...in x direction
238 C
239  j=jj
240 C
241 C ...in y direction
242 C
243  yp=yparam
244  ypi=1.0-yp
245 C
246  do v=1,ivec
247  i=ii(v)
248 c
249  xp=xparam(v)
250  xpi=1.0-xp
251 C
252  iadr=0
253 C
254 C get desired values:
255 C
256  if(ict(1).eq.1) then
257 C
258 C function value:
259 C
260  iadr=iadr+1
261  sum=ypi*(xpi*fin(i,j)+xp*fin(i+1,j))
262  > + yp*(xpi*fin(i,j+1)+xp*fin(i+1,j+1))
263 C
264  fval(v,iadr)=sum
265  endif
266 C
267  if(ict(2).eq.1) then
268 C
269 C df/dx:
270 C
271  iadr=iadr+1
272 C
273  sum=ypi*(fin(i+1,j)-fin(i,j))
274  > + yp*(fin(i+1,j+1)-fin(i,j+1))
275  fval(v,iadr)=sum*hxi(v)
276 C
277  endif
278 C
279  if(ict(3).eq.1) then
280 C
281 C df/dy:
282 C
283  iadr=iadr+1
284 C
285  sum=xpi*(fin(i,j+1)-fin(i,j))
286  > + xp*(fin(i+1,j+1)-fin(i+1,j))
287  fval(v,iadr)=sum*hyi
288  endif
289 C
290  if(ict(4).eq.1) then
291 C
292 C d2f/dxdy:
293 C
294  iadr=iadr+1
295 C
296  sum=fin(i+1,j+1)-fin(i,j+1)-fin(i+1,j)+fin(i,j)
297  fval(v,iadr)=sum*hxi(v)*hyi
298  endif
299 C
300  enddo ! vector loop
301 C
302  return
303  end