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