V3FIT
f3test.f
1  subroutine f3test(fun1,fun2,id,inump,
2  > xmin,xmax,ymin,ymax,zmin,zmax,
3  > name,namex,namey,namez)
4 c
5 c test/compare 2 methods of evaluation of 3d function values and derivatives
6 c
7 c passed:
8 c subroutine fun1(x,y,z,fget1(1..10))
9 c subroutine fun2(x,y,z,fget2(1..10))
10 c
11 c (input x,y, return vector of 6 numbers containing, in order:
12 c f,df/dx,df/dy,df/dz,d2f/dx2,d2f/dy2,d2f/dz2,d2f/dxdy,d2f/dxdz,d2f/dydz)
13 c
14  external fun1,fun2
15 c
16  integer id ! 1 for 1st derivs, 2 for 2nd derivs.
17  integer inump ! #evals per dimension
18 c
19  real xmin,xmax ! x range
20  real ymin,ymax ! y range
21  real zmin,zmax ! z range
22 c
23  character*(*) name ! name/label for fcns --
24  character*(*) namex,namey,namez ! name/label for x & y dims
25 c
26 c NOTE `name*' should be short with no leading or trailing blanks
27 c
28 c local:
29 c
30  real fget1(10),fget2(10),fmin(10),fmax(10),fdifa(10)
31 c
32 c output of routine: stats written to unit 6
33 c
34 c--------------------------------
35 c
36  data icyc/100000/
37 c
38  do i=1,10
39  fmin(i)=1.0e35
40  fmax(i)=-1.0e35
41  fdifa(i)=0.0
42  enddo
43 c
44  ict=0
45 c
46  if(id.eq.2) then
47  ifvals=10
48  else
49  ifvals=4
50  endif
51 c
52  do iz=1,inump
53  zz=zmin+float(iz-1)*(zmax-zmin)/float(inump-1)
54  do iy=1,inump
55  zy=ymin+float(iy-1)*(ymax-ymin)/float(inump-1)
56  do ix=1,inump
57  zx=xmin+float(ix-1)*(xmax-xmin)/float(inump-1)
58 c
59  ict=ict+1
60  if(icyc*(ict/icyc).eq.ict) then
61  write(6,1001) ix,zx,iy,zy,iz,zz
62  1001 format(
63  > ' ...f3test at x(',i5,')=',1pe11.4,
64  > ', y(',i5,')=',1pe11.4,', z(',i5,')=',1pe11.4)
65  endif
66 c
67  call fun1(zx,zy,zz,fget1)
68  call fun2(zx,zy,zz,fget2)
69 c
70  do i=1,ifvals
71  fmin(i)=min(fmin(i),fget1(i),fget2(i))
72  fmax(i)=max(fmax(i),fget1(i),fget2(i))
73  zdifa=abs(fget1(i)-fget2(i))
74  fdifa(i)=max(fdifa(i),zdifa)
75  enddo
76 c
77  enddo
78  enddo
79  enddo
80 c
81  write(6,1002) namex,namey,namez,name,
82  > (name,fmin(i),fmax(i),fdifa(i),i=1,4)
83  1002 format(/
84  >' test function comparison:'/
85  >' x stands for "',a,'"; y stands for "',a,
86  > '"; z stands for "',a/
87  >' (',a,') min value max value max |diff|'/
88  >' ',a,': ',3(1pe11.3,2x)/
89  >' d',a,'/dx: ',3(1pe11.3,2x)/
90  >' d',a,'/dy: ',3(1pe11.3,2x)/
91  >' d',a,'/dz: ',3(1pe11.3,2x))
92  if(ifvals.gt.4) write(6,1003)
93  > (name,fmin(i),fmax(i),fdifa(i),i=5,10)
94  1003 format(
95  >' d2',a,'/dx2: ',3(1pe11.3,2x)/
96  >' d2',a,'/dy2: ',3(1pe11.3,2x)/
97  >' d2',a,'/dz2: ',3(1pe11.3,2x)/
98  >' d2',a,'/dxdy: ',3(1pe11.3,2x)/
99  >' d2',a,'/dxdz: ',3(1pe11.3,2x)/
100  >' d2',a,'/dydz: ',3(1pe11.3,2x))
101 c
102  return
103  end