V3FIT
r8mkherm2.f
1  subroutine r8mkherm2(fun,x,nx,y,ny,fherm)
2 C
3 C create a data set for Hermite interpolation, from evaluation of
4 C function and derivatives. function of 2 indep. coordinates.
5 C
6 C input:
7 C
8 !============
9 ! idecl: explicitize implicit INTEGER declarations:
10  IMPLICIT NONE
11  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
12  INTEGER ny,nx,ix,iy
13 !============
14 ! idecl: explicitize implicit REAL declarations:
15  real*8 fun,dfdx,dfdy,d2fdxdy
16 !============
17  external fun ! passed real function(x,y)
18  real*8 x(nx) ! x coordinate array
19  real*8 y(ny) ! y coordinate array
20 C
21 C the passed function fun must have the interface:
22 C
23 C real function <name>(x,y,dfdx,dfdy,d2fdxdy)
24 C where x,y are input, the function returns the function value,
25 C and the arguments dfdx and dfdy return as output the function
26 C derivative at the point (x,y).
27 C
28 C output:
29 C
30  real*8 fherm(0:3,nx,ny) ! function data & derivatives
31 C
32 C fherm(0,i,j) = function value f at x(i),y(j)
33 C fherm(1,i,j) = derivative df/dx at x(i),y(j)
34 C fherm(2,i,j) = derivative df/dy at x(i),y(j)
35 C fherm(3,i,j) = derivative d2f/dxdy at x(i),y(j)
36 C
37 C----------------------------
38 C
39  do ix=1,nx
40  do iy=1,ny
41  fherm(0,ix,iy)=fun(x(ix),y(iy),dfdx,dfdy,d2fdxdy)
42  fherm(1,ix,iy)=dfdx
43  fherm(2,ix,iy)=dfdy
44  fherm(3,ix,iy)=d2fdxdy
45  enddo
46  enddo
47 C
48  return
49  end