#include "fpreproc/f77_dcomplx.h"
subroutine f3test(fun1,fun2,id,inump, &
     xmin,xmax,ymin,ymax,zmin,zmax, &
     name,namex,namey,namez)
  use iso_c_binding, only: fp => c_double
  !
  !   test/compare 2 methods of evaluation of 3d function values and derivatives
  !
  !     passed:
  !       subroutine fun1(x,y,z,fget1(1..10))
  !       subroutine fun2(x,y,z,fget2(1..10))
  !
  !          (input x,y, return vector of 6 numbers containing, in order:
  !     f,df/dx,df/dy,df/dz,d2f/dx2,d2f/dy2,d2f/dz2,d2f/dxdy,d2f/dxdz,d2f/dydz)
  !
  !============
  implicit none
  integer icyc,i,ict,ifvals,iz,iy,ix
  !============
  real(fp) :: zz,zy,zx,zdifa
  !============
  external fun1,fun2
  !
  integer id                        ! 1 for 1st derivs, 2 for 2nd derivs.
  integer inump                     ! #evals per dimension
  !
  real(fp) :: xmin,xmax                    ! x range
  real(fp) :: ymin,ymax                    ! y range
  real(fp) :: zmin,zmax                    ! z range
  !
  character(len=*) name                ! name/label for fcns --
  character(len=*) namex,namey,namez   ! name/label for x & y dims
  !
  !  NOTE `name*' should be short with no leading or trailing blanks
  !
  !  local:
  !
  real(fp) :: fget1(10),fget2(10),fmin(10),fmax(10),fdifa(10)
  !
  !  output of routine:  stats written to unit 6
  !
  !--------------------------------
  !
  data icyc/100000/
  !
  do i=1,10
     fmin(i)=1.0E35_fp
     fmax(i)=-1.0E35_fp
     fdifa(i)=0.0_fp
  end do
  !
  ict=0
  !
  if(id.eq.2) then
     ifvals=10
  else
     ifvals=4
  end if
  !
  do iz=1,inump
     zz=zmin+real(iz-1,fp)*(zmax-zmin)/real(inump-1,fp)
     do iy=1,inump
        zy=ymin+real(iy-1,fp)*(ymax-ymin)/real(inump-1,fp)
        do ix=1,inump
           zx=xmin+real(ix-1,fp)*(xmax-xmin)/real(inump-1,fp)
           !
           ict=ict+1
           if(icyc*(ict/icyc).eq.ict) then
              write(6,1001) ix,zx,iy,zy,iz,zz
1001          format( &
                   '  ...f3test at x(',i5,')=',1pe11.4, &
                   ', y(',i5,')=',1pe11.4,', z(',i5,')=',1pe11.4)
           end if
           !
           call fun1(zx,zy,zz,fget1)
           call fun2(zx,zy,zz,fget2)
           !
           do i=1,ifvals
              fmin(i)=min(fmin(i),fget1(i),fget2(i))
              fmax(i)=max(fmax(i),fget1(i),fget2(i))
              zdifa=abs(fget1(i)-fget2(i))
              fdifa(i)=max(fdifa(i),zdifa)
           end do
           !
        end do
     end do
  end do
  !
  write(6,1002) namex,namey,namez,name, &
       (name,fmin(i),fmax(i),fdifa(i),i=1,4)
1002 format(/ &
       '  test function comparison:'/ &
       '     x stands for "',a,'";  y stands for "',a, &
       '"; z stands for "',a/ &
       '     (',a,')     min value   max value   max |diff|'/ &
       '   ',a,':      ',3(1pe11.3,2x)/ &
       '  d',a,'/dx:   ',3(1pe11.3,2x)/ &
       '  d',a,'/dy:   ',3(1pe11.3,2x)/ &
       '  d',a,'/dz:   ',3(1pe11.3,2x))
  if(ifvals.gt.4) write(6,1003) &
       (name,fmin(i),fmax(i),fdifa(i),i=5,10)
1003 format( &
       ' d2',a,'/dx2:  ',3(1pe11.3,2x)/ &
       ' d2',a,'/dy2:  ',3(1pe11.3,2x)/ &
       ' d2',a,'/dz2:  ',3(1pe11.3,2x)/ &
       ' d2',a,'/dxdy: ',3(1pe11.3,2x)/ &
       ' d2',a,'/dxdz: ',3(1pe11.3,2x)/ &
       ' d2',a,'/dydz: ',3(1pe11.3,2x))
  !
  return
end subroutine f3test
