V3FIT
spvec.f
1  subroutine spvec(ict,ivec,xvec,ivd,fval,nx,xpkg,fspl,iwarn,ier)
2 c
3 c vectorized spline evaluation routine -- 1d spline
4 c 1. call vectorized zone lookup routine
5 c 2. call vectorized spline evaluation routine
6 c
7 c--------------------------
8 c input:
9  integer ict(3) ! selector:
10 c ict(1)=1 for f (don't evaluate if ict(1)=0)
11 c ict(2)=1 for df/dx (don't evaluate if ict(2)=0)
12 c ict(3)=1 for d2f/dx2 (don't evaluate if ict(3)=0)
13 c
14  integer ivec ! vector dimensioning
15 c
16 c ivec-- number of vector pts (spline values to look up)
17 c
18  real xvec(ivec) ! x-locations at which to evaluate
19 c
20  integer ivd ! 1st dimension of output array
21 c
22 c ivd -- 1st dimension of fval, .ge.ivec
23 c
24 c output:
25  real fval(ivd,*) ! output array
26 c
27 c fval(1:ivec,1) -- values as per 1st non-zero ict(...) element
28 c fval(1:ivec,2) -- values as per 2nd non-zero ict(...) element
29 c --etc--
30 c
31 c input:
32  integer nx ! dimension of spline x grid
33  real xpkg(nx,4) ! x grid "package" (cf genxpkg)
34  real fspl(4,nx) ! (non-compact) spline coefficients
35 c
36 c output:
37 c condition codes, 0 = normal return
38  integer iwarn ! =1 if an x value was out of range
39  integer ier ! =1 if argument error detected
40 c
41 c---------------------------------------------------------------
42 c local arrays
43 c
44  integer iv(ivec) ! zone indices
45  real dxv(ivec) ! displacements w/in zones
46 c
47 c---------------------------------------------------------------
48 c
49 c error checks
50 c
51  ier=0
52  if(nx.lt.2) then
53  write(6,*) .lt.' ?spvec: nx2: nx = ',nx
54  ier=1
55  endif
56 c
57  if(ivec.le.0) then
58  write(6,*) .le.' ?spvec: vector dimension 0: ivec = ',ivec
59  ier=1
60  endif
61 c
62  if(ivd.lt.ivec) then
63  write(6,*)
64  > ' ?spvec: output vector dimension less than input ',
65  > 'vector dimension.'
66  write(6,*) ' ivec=',ivec,' ivd=',ivd
67  ier=1
68  endif
69 c
70  if(ier.ne.0) return
71 c
72 c vectorized lookup
73 c
74  iv=0
75  call xlookup(ivec,xvec,nx,xpkg,1,iv,dxv,dxv,dxv,iwarn)
76 c
77 c vectorized evaluation
78 c
79  call cspevfn(ict,ivec,ivd,fval,iv,dxv,fspl,nx)
80 c
81  return
82  end