V3FIT
vecbicub.f
1  subroutine vecbicub(ict,ivec,xvec,yvec,ivd,fval,
2  > nx,xpkg,ny,ypkg,fspl,inf2,
3  > iwarn,ier)
4 c
5 c vectorized spline evaluation routine -- 2d *compact* spline
6 c 1. call vectorized zone lookup routine
7 c 2. call vectorized spline evaluation routine
8 c
9 c--------------------------
10 c input:
11  integer ict(6) ! selector:
12 c ict(1)=1 for f (don't evaluate if ict(1)=0)
13 c ict(2)=1 for df/dx (don't evaluate if ict(2)=0)
14 c ict(3)=1 for df/dy (don't evaluate if ict(3)=0)
15 c ict(4)=1 for d2f/dx2 (don't evaluate if ict(4)=0)
16 c ict(5)=1 for d2f/dy2 (don't evaluate if ict(5)=0)
17 c ict(6)=1 for d2f/dxdy (don't evaluate if ict(6)=0)
18 c
19  integer ivec ! vector dimensioning
20 c
21 c ivec-- number of vector pts (spline values to look up)
22 c
23 c list of (x,y) pairs:
24 c
25  real xvec(ivec) ! x-locations at which to evaluate
26  real yvec(ivec) ! y-locations at which to evaluate
27 c
28  integer ivd ! 1st dimension of output array
29 c
30 c ivd -- 1st dimension of fval, .ge.ivec
31 c
32 c output:
33  real fval(ivd,*) ! output array
34 c
35 c fval(1:ivec,1) -- values as per 1st non-zero ict(...) element
36 c fval(1:ivec,2) -- values as per 2nd non-zero ict(...) element
37 c --etc--
38 c
39 c input:
40  integer nx,ny ! dimension of spline grids
41  real xpkg(nx,4) ! x grid "package" (cf genxpkg)
42  real ypkg(ny,4) ! y grid "package" (cf genxpkg)
43  integer inf2 ! fspl 3rd array dimension, .ge.nx
44  real fspl(0:3,inf2,ny) ! (compact) spline coefficients
45 c
46 c output:
47 c condition codes, 0 = normal return
48  integer iwarn ! =1 if an x value was out of range
49  integer ier ! =1 if argument error detected
50 c
51 c---------------------------------------------------------------
52 c local arrays
53 c
54  integer ix(ivec) ! zone indices {j}
55  real dxn(ivec) ! normalized displacements w/in zones
56  real hx(ivec) ! h(j) vector
57  real hxi(ivec) ! 1/h(j) vector
58 c
59  integer iy(ivec) ! zone indices {j}
60  real dyn(ivec) ! normalized displacements w/in zones
61  real hy(ivec) ! h(j) vector
62  real hyi(ivec) ! 1/h(j) vector
63 c
64 c---------------------------------------------------------------
65 c
66 c error checks
67 c
68  ier=0
69 c
70  if(nx.lt.2) then
71  write(6,*) .lt.' ?vecbicub: nx2: nx = ',nx
72  ier=1
73  endif
74 c
75  if(ny.lt.2) then
76  write(6,*) .lt.' ?vecbicub: ny2: ny = ',ny
77  ier=1
78  endif
79 c
80  if(ivec.le.0) then
81  write(6,*) .le.' ?vecbicub: vector dimension 0: ivec = ',
82  > ivec
83  ier=1
84  endif
85 c
86  if(ivd.lt.ivec) then
87  write(6,*)
88  > ' ?vecbicub: output vector dimension less than input ',
89  > 'vector dimension.'
90  write(6,*) ' ivec=',ivec,' ivd=',ivd
91  ier=1
92  endif
93 c
94  if(ier.ne.0) return
95 c
96 c vectorized lookup
97 c
98  ix=0
99  iy=0
100  call xlookup(ivec,xvec,nx,xpkg,2,ix,dxn,hx,hxi,iwarn1)
101  call xlookup(ivec,yvec,ny,ypkg,2,iy,dyn,hy,hyi,iwarn2)
102  iwarn=iwarn1+iwarn2
103 c
104 c vectorized evaluation
105 c
106  call fvbicub(ict,ivec,ivd,fval,ix,iy,dxn,dyn,
107  > hx,hxi,hy,hyi,fspl,inf2,ny)
108 c
109  return
110  end