program histo_double
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_format
  !---------------------------------------------------------------------
  ! GDF	Main program for making a Histogram from two maps
  !
  ! Subroutines	HISTO003
  !---------------------------------------------------------------------
  ! Local
  character(len=filename_length) :: namex,namey,namez
  logical :: error
  real :: hmin,hmax,hstep
  integer, parameter :: mdim=4
  integer :: n, pmin(mdim), pmax(mdim), nh, ier
  type(gildas) :: x,y,z
  !
  call gildas_open
  call gildas_char('Z_NAME$',namez)
  call gildas_char('Y_NAME$',namey)
  call gildas_inte('Y_BLC$',pmin,mdim)
  call gildas_inte('Y_TRC$',pmax,mdim)
  call gildas_inte('X_BINS$',nh,1)
  call gildas_real('X_MIN$',hmin,1)
  call gildas_real('X_MAX$',hmax,1)
  call gildas_char('X_NAME$',namex)
  call gildas_close
  !
  call gildas_null(z)
  z%blc(1:mdim) = pmin
  z%trc(1:mdim) = pmax
  call gdf_read_gildas(z,namez,'.gdf',error,rank=0)
  if (error) goto 100
  !
  ! y%gil%form = fmt_r4 ! This is the default
  call gildas_null(y)
  y%blc(1:mdim) = pmin
  y%trc(1:mdim) = pmax
  call gdf_read_gildas(y,namey,'.gdf',error,rank=0)
  if (error) goto 100
  !
  ! Define output histogram
  n = len_trim(namex)
  if (n.eq.0) goto 100
  call gildas_null(x, type= 'TABLE') 
  call sic_parsef(namex(1:n),x%file,' ','.gdf')
  x%gil%ndim = 2
  x%gil%dim(1) = nh
  x%gil%dim(2) = 4
  x%loca%size = x%gil%dim(1)*x%gil%dim(2)
  hstep = (hmax-hmin)/(nh+1)
  allocate(x%r2d(nh,4), stat=ier)
  !
  call histo003(z%r1d,y%r1d,y%loca%size,y%gil%bval,y%gil%eval,   &
     &    x%r2d,x%gil%dim(1),hmin,hstep)
  call gdf_write_image (x,x%r2d,error)
  !
  call gagout('S-HISTO_DOUBLE,  Successful completion')
  call sysexi (1)
  !
100 call sysexi(fatale)
end program histo_double
!
subroutine histo003(z,y,n, bval,eval, x,nh,hmin,hstep)
  use gildas_def
  !---------------------------------------------------------------------
  ! GDF	Internal routine
  !	Computes the histogram of part of an Y image, as a
  !	function of another Z. The output histogram X contains
  !	(1)	Mean value of Y image
  !	(2)	Standard deviation
  !	(3)	Number of pixels
  !	(4)	Value of input Z image
  !
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in) :: n                     !
  real, intent(in) :: z(n)           ! Array of histogram definition
  real, intent(in) :: y(n)           ! Array of values
  real, intent(in) :: bval                      ! Blanking
  real, intent(in) :: eval                      ! and tolerance
  integer(index_length), intent(in) :: nh       ! Size of histogram
  real, intent(out) :: x(nh,4)                  ! Histogram
  real, intent(in) :: hmin                      ! Minimum
  real, intent(in) :: hstep                     ! Step
  ! Local
  integer(kind=size_length) :: i, ntot,nin,nout,nblank
  integer :: nval, j
  !
  nin = 0
  nout = 0
  nblank = 0
  x = 0.0
  !
  do i=1,n
    if (abs(z(i)-bval).gt.eval) then
      nval = 1+int((z(i)-hmin)/hstep)
      if (nval.ge.1 .and. nval.le.nh) then
        if (abs(y(i)-bval).gt.eval) then
          x(nval,1) = x(nval,1)+y(i)
          x(nval,2) = x(nval,2)+y(i)**2
          x(nval,3) = x(nval,3)+1.
          nin = nin+1
        else
          nblank = nblank+1
        endif
      else
        nout= nout+1
      endif
    else
      nblank = nblank+1
    endif
  enddo
  !
  ! Now fill the histogram definition
  do j=1,nh
    x(j,4) = hmin + (n+0.5)*hstep
    if (x(j,3).ne.0.) then
      x(j,1) = x(j,1)/x(j,3)
      x(j,2) = sqrt(x(j,2)/x(j,3)-x(j,1)**2)
    endif
  enddo
  ntot = nin+nout+nblank
  write(6,100) nin,float(nin)/float(ntot)*1.e2,   &
     &    nout,float(nout)/float(ntot)*1.e2,   &
     &    nblank,float(nblank)/float(ntot)*1.e2,   &
     &    ntot
100 format(1x,'Number of points in histogram ',i8,4x,f5.1,' Z',   &
     &    /,'   "    "    "    out of  "    ',i8,4x,f5.1,' %',   &
     &    /,'   "    "    "    blanked      ',i8,4x,f5.1,' %',   &
     &    /,'                  Total      = ',i8)
end subroutine histo003
