program histo_cross
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_format
  !---------------------------------------------------------------------
  ! GDF
  ! Main program for making a cross histogram from two images/data cubes
  !---------------------------------------------------------------------
  ! Local
  type(gildas) :: in1,in2,out
  character(len=filename_length) :: namez,namey,namex
  logical :: error
  real(kind=4) :: hzmin,hzmax,hzstep, hymin,hymax,hystep
  integer(kind=4) :: n, nhz, nhy,ier
  integer(kind=index_length) :: i
  !
  error = .false.
  !
  call gildas_open
  call gildas_char('Z_NAME$',namez)
  call gildas_inte('Z_BINS$',nhz,1)
  call gildas_real('Z_MIN$',hzmin,1)
  call gildas_real('Z_MAX$',hzmax,1)
  call gildas_char('Y_NAME$',namey)
  call gildas_inte('Y_BINS$',nhy,1)
  call gildas_real('Y_MIN$',hymin,1)
  call gildas_real('Y_MAX$',hymax,1)
  call gildas_char('X_NAME$',namex)
  call gildas_close
  !
  ! Read input cubes
  !
  call gildas_null(in1)
  call gdf_read_gildas(in1,namez,'.gdf',error,rank=3)
  if (error) call sysexi(fatale)
  !
  call gildas_null(in2)
  call gdf_read_gildas(in2,namey,'.gdf',error,rank=3)
  if (error) call sysexi(fatale)
  !
  ! Define output histogram
  n = len_trim(namex)
  if (n.eq.0) call sysexi(fatale)
  call gildas_null(out)
  call gdf_copy_header(in1,out,error)
  call sic_parsef(namex(1:n),out%file,' ','.gdf')
  !
  ! Check 3rd axis: Both input cubes must match
  if (in1%gil%ndim.ne.in2%gil%ndim) then
     call gagout('E-HISTO_CROSS,  Input data cubes do not match')
     call sysexi(fatale)
  endif
  !
  ! Thresholds : Read or compute.
  !
  if (hzmin.eq.0. .and. hzmax.eq.0.) then
    call histo_cross_minmax(in1%r3d,in1%gil%dim(1),in1%gil%dim(2),in1%gil%dim(3),&
         in1%gil%bval,in1%gil%eval,hzmin,hzmax)
  endif
  if (hymin.eq.0. .and. hymax.eq.0.) then
    call histo_cross_minmax(in2%r3d,in2%gil%dim(1),in2%gil%dim(2),in2%gil%dim(3),&
         in2%gil%bval,in2%gil%eval,hymin,hymax)
  endif
  hzstep = (hzmax-hzmin)/(nhz-1)
  hystep = (hymax-hymin)/(nhy-1)
  !
  ! Initialize Header
  !
  out%gil%form    = fmt_r4
  out%gil%ndim    = in1%gil%ndim
  out%gil%dim(1)  = nhz
  out%gil%dim(2)  = nhy
  out%gil%dim(3)  = in1%gil%dim(3)
  out%gil%ref(1)  = 1.d0
  out%gil%val(1)  = hzmin
  out%gil%inc(1)  = hzstep
  out%gil%ref(2)  = 1.d0
  out%gil%val(2)  = hymin
  out%gil%inc(2)  = hystep
  out%gil%convert(:,3) = in1%gil%convert(:,3)
  ! EXTREMA
  out%gil%extr_words = 0  ! No more
  ! POSITION: nothing relevant except...
 !out%char%name   = kept from input for bookkeeping
  out%char%syst   = ' '
  out%gil%ra      = 0.d0
  out%gil%dec     = 0.d0
  out%gil%lii     = 0.d0
  out%gil%bii     = 0.d0
  out%gil%epoc    = 0.d0
  ! PROJECTION
  out%gil%proj_words = 0  ! No more
  ! SPECTROSCOPY
  out%gil%spec_words = 12
  out%gil%freq    = in1%gil%freq
  out%gil%voff    = in1%gil%voff
  out%gil%vres    = in1%gil%vres
  out%gil%fima    = in1%gil%fima
  out%gil%fres    = in1%gil%fres
  out%gil%faxi    = in1%gil%faxi
  out%gil%bval    = 0.d0
  out%gil%eval    = -1.d0
  ! DESCRIPTION
  out%char%code(1)= in1%char%unit     ! X axis covers the 1st input data scale
  out%char%code(2)= in2%char%unit     ! Y axis covers the 2nd input data scale
  out%char%code(3)= in1%char%code(3)  ! Same freq axis
  out%char%code(4)= 'UNKNOWN     '    ! Clean 4th axis
  out%char%unit   = 'pixels/bin  '    ! Data array unit
  !
  ! Change boundaries
  !
  hzmin = hzmin - 0.5*hzstep
  hzmax = hzmax + 0.5*hzstep
  hymin = hymin - 0.5*hystep
  hymax = hymax + 0.5*hystep
  !
  ! Zero projection information
  !
  allocate(out%r3d(nhz,nhy,out%gil%dim(3)),stat=ier)
  if (ier.ne.0) then
    call gagout('E-HISTO_CROSS, Memory allocation error')
    call sysexi(fatale)
  endif
  !
  ! Compute cross histogram for each plane
  !
  do i=1,out%gil%dim(3)
    call histo001(  &
        in1%r3d(:,:,i), in2%r3d(:,:,i),                       &
        in1%gil%dim(1),in1%gil%dim(2),                       &
        in1%gil%bval,in1%gil%eval,in2%gil%bval,in2%gil%eval, &
        hzmin,hzstep,hzmax,hymin,hystep,hymax,               &
        out%gil%dim(1),out%gil%dim(2),out%r3d(:,:,i))
  enddo
  !
  ! Write the output image
  !
  call gdf_write_image(out,out%r3d,error)
  if (error) then
    call gagout('E-HISTO_CROSS, Error writing output image')
    call sysexi(fatale)
  endif
  !
  ! Normal end
  !
  call gagout('S-HISTO_CROSS,  Successful completion')
  call sysexi (1)
  !
end program histo_cross
!
subroutine histo001 (z,y,nx,ny,zbval,zeval,ybval,yeval,  &
     pzmin,pzstep,pzmax,pymin,pystep,pymax,  &
     nhz,nhy,h)
  use gildas_def
  !---------------------------------------------------------------------
  ! GDF
  ! Computes the crossed histogram map of two images.
  !	Input images must have the same blanking value and
  !	be coincident. Histogram parameters must have been
  !	defined in a coherent way before.
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in)  :: nx          ! 1st dimension of input images
  integer(kind=index_length), intent(in)  :: ny          ! 2nd dimension of input images
  real(kind=4),               intent(in)  :: z(nx,ny)    ! first input image
  real(kind=4),               intent(in)  :: y(nx,ny)    ! second input image
  real(kind=4),               intent(in)  :: zbval       ! blanking value of 1st input image
  real(kind=4),               intent(in)  :: zeval       ! tolerance on blanking value
  real(kind=4),               intent(in)  :: ybval       ! blanking value of 2nd input image
  real(kind=4),               intent(in)  :: yeval       ! tolerance on blanking value
  real(kind=4),               intent(in)  :: pzmin       ! low threshold for z input array
  real(kind=4),               intent(in)  :: pzstep      ! histogram step for z input array
  real(kind=4),               intent(in)  :: pzmax       ! max threshold for z input array
  real(kind=4),               intent(in)  :: pymin       ! low threshold for y input array
  real(kind=4),               intent(in)  :: pystep      ! histogram step for y input array
  real(kind=4),               intent(in)  :: pymax       ! max threshold for y input array
  integer(kind=index_length), intent(in)  :: nhz         ! 1st dim of output image
  integer(kind=index_length), intent(in)  :: nhy         ! 2nd dim of output image
  real(kind=4),               intent(out) :: h(nhz,nhy)  ! histogram array
  ! Local
  integer(kind=index_length) :: i,j,iz,jy
  integer(kind=size_length) :: nin,nout,nblank,ntot
  !
  h(:,:) = 0.
  nin    = 0
  nout   = 0
  nblank = 0
  !
  if (zeval.ge.0.0 .and. yeval.ge.0) then
    !
    do j=1,ny
      do i=1,nx
        if (abs(z(i,j)-zbval).gt.zeval.and.abs(y(i,j)-ybval).gt.yeval) then
          if (z(i,j).ge.pzmin.and.z(i,j).lt.pzmax) then
            iz = int((z(i,j)-pzmin)/pzstep) + 1
            if (y(i,j).ge.pymin .and. y(i,j).lt.pymax) then
              jy = int((y(i,j)-pymin)/pystep) + 1
              h(iz,jy) = h(iz,jy)+1.0
              nin = nin+1
            else
              nout = nout+1
            endif
          else
            nout = nout+1
          endif
        else
          nblank = nblank+1
        endif
      enddo
    enddo
    !
  else
    !
    do j=1,ny
      do i=1,nx
        if (z(i,j).ge.pzmin .and. z(i,j).lt.pzmax) then
          iz = int((z(i,j)-pzmin)/pzstep) + 1
          if (y(i,j).ge.pymin .and. y(i,j).le.pymax) then
             jy = int((y(i,j)-pymin)/pystep) + 1
             h(iz,jy) = h(iz,jy)+1.0
             nin = nin+1
          else
             nout = nout+1
          endif
        else
          nout = nout+1
        endif
      enddo
    enddo
    !
  endif
  !
  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 histo001
!
subroutine histo_cross_minmax(in,nx,ny,nz,bval,eval,low,high)
  use gildas_def
  !---------------------------------------------------------------------
  ! Computes the extrema of an 3D array
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in)  :: nx            !
  integer(kind=index_length), intent(in)  :: ny            !
  integer(kind=index_length), intent(in)  :: nz            !
  real(kind=4),               intent(in)  :: in(nx,ny,nz)  !
  real(kind=4),               intent(in)  :: bval          !
  real(kind=4),               intent(in)  :: eval          !
  real(kind=4),               intent(out) :: low           !
  real(kind=4),               intent(out) :: high          !
  ! Local
  real(kind=4), dimension(nx,ny) :: wmin,wmax
  !
  if (eval.ge.0.) then
    wmin = minval(in,3,mask=(abs(in-bval).gt.eval))
    wmax = maxval(in,3,mask=(abs(in-bval).gt.eval))
    low  = minval(wmin)
    high = maxval(wmax)
  endif
end subroutine histo_cross_minmax
