V3FIT
dnherm2.f
1  subroutine dnherm2(x,nx,y,ny,fherm,nf2,ilinx,iliny,ier)
2 C
3 C create a data set for Hermite interpolation, based on simple
4 C numerical differentiation using the given grid. The grid should
5 C be "approximately" evenly spaced.
6 C
7 C 2d routine
8 C
9 C input:
10 C
11 C nf2.gt.nx expected!
12 C
13  integer nx,ny,nf2 ! array dimensions
14  real x(nx) ! x coordinate array
15  real y(ny) ! y coordinate array
16  real fherm(0:3,nf2,ny) ! data/Hermite array
17 C
18 C fherm(0,i,j) = function value f at x(i),y(j) **on input**
19 C
20 C fherm(1,i,j) = derivative df/dx at x(i),y(j) **on output**
21 C fherm(2,i,j) = derivative df/dy at x(i),y(j) **on output**
22 C fherm(3,i,j) = derivative d2f/dxdy at x(i),y(j) **on output**
23 C
24 C addl output:
25 C ilinx=1 if x axis is evenly spaced
26 C iliny=1 if y axis is evenly spaced
27 C ier=0 if no error:
28 C x, y must both be strict ascending
29 C nf2.ge.nx is required.
30 C
31 C----------------------------
32 c
33  ier=0
34 c
35  call splinck(x,nx,ilinx,1.0e-3,ierx)
36  if(ierx.ne.0) ier=2
37 c
38  if(ier.eq.2) then
39  write(6,'('' ?dnherm2: x axis not strict ascending'')')
40  endif
41 c
42  call splinck(y,ny,iliny,1.0e-3,iery)
43  if(iery.ne.0) ier=3
44 c
45  if(ier.eq.3) then
46  write(6,'('' ?dnherm2: y axis not strict ascending'')')
47  endif
48 c
49  if(nf2.lt.nx) then
50  ier=4
51  write(6,*) '?dnherm2: fherm array dimension too small.'
52  endif
53 C
54  if(ier.ne.0) return
55 C
56  do iy=1,ny
57 c
58  iyp=min(ny,iy+1)
59  iym=max(1,iy-1)
60 c
61  do ix=1,nx
62 c
63  ixp=min(nx,ix+1)
64  ixm=max(1,ix-1)
65 c
66 c x diffs in vicinity
67 c
68  zd=(fherm(0,ixp,iy)-fherm(0,ixm,iy))/(x(ixp)-x(ixm))
69 c
70  fherm(1,ix,iy)=zd
71 c
72 c y diffs in vicinity
73 c
74  zd=(fherm(0,ix,iyp)-fherm(0,ix,iym))/(y(iyp)-y(iym))
75 c
76  fherm(2,ix,iy)=zd
77 c
78 c xy cross derivs (except at corners, iedge=2)
79 c
80  fherm(3,ix,iy)=(fherm(0,ixp,iyp)-fherm(0,ixm,iyp)
81  > -fherm(0,ixp,iym)+fherm(0,ixm,iym))/
82  > ((x(ixp)-x(ixm))*(y(iyp)-y(iym)))
83 c
84  enddo
85  enddo
86 C
87  return
88  end