program histo_cloud
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! GDF	Main program for making a "Cloud of Points" Histogram from two maps
  !---------------------------------------------------------------------
  ! Local
  character(len=filename_length) :: namez,namey,namex
  logical :: error
  integer :: ier
  integer(kind=size_length) :: n, npoin, nmax
  type(gildas) :: x,y,z
  real, allocatable :: work(:,:)
  !
  call gildas_open
  call gildas_char('Z_NAME$',namez)
  call gildas_char('Y_NAME$',namey)
  call gildas_char('X_NAME$',namex)
  call gildas_close
  !
  ! Map first image
  !
  call gildas_null(z)
  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)
  call gdf_read_gildas(y,namey,'.gdf',error,rank=0)
  if (error) goto 100
  !
  ! How many points will be put in the table ? 
  ! (i.e. the dimension of the table)
  if (y%gil%blan_words.eq.0) y%gil%eval=-1.0
  if (z%gil%blan_words.eq.0) z%gil%eval=-1.0
  nmax = y%gil%dim(1)*y%gil%dim(2)
  if (nmax.ne.z%gil%dim(1)*z%gil%dim(2)) then
    call gagout('F-HISTO_CLOUD,  Images are not coincident')
    goto 100
  endif
  allocate(work(y%loca%size,2), stat=ier)
  if (ier.ne.0) then
    call gagout('F-HISTO_CLOUD,  Memory allocation error')
    goto 100
  endif
  call cloud001(z%r1d, y%r1d,  &
     &    y%loca%size, y%gil%bval,y%gil%eval,z%gil%bval,z%gil%eval,   &
     &    work,nmax,npoin)
  if (npoin.eq.0) then
    call gagout('F-HISTO_CLOUD,  No Point in Table')
    goto 100
  endif
  !
  ! Open output table (2columns)
  n = len_trim(namex)
  if (n.eq.0) goto 100
  call gildas_null(x, type= 'TABLE') 
  call sic_parsef(namex(1:n),x%file,' ','.tab')
  x%gil%dim(1) = npoin
  x%gil%dim(2) = 2
  x%gil%ndim = 2
  allocate (x%r2d(npoin,2), stat=ier)
  x%r2d(:,1) = work(1:npoin, 1)
  x%r2d(:,2) = work(1:npoin, 2)
  call gdf_write_image(x, x%r2d, error)
  call gagout('S-HISTO_CLOUD,  Successful completion')
  call sysexi(1)
  !
100 call sysexi(fatale)
end program histo_cloud
!
subroutine cloud001 (z,y,nxy,bvaly,evaly,bvalz,evalz,h,   &
     &    nmax,nin)
  use gildas_def
  !---------------------------------------------------------------------
  ! GDF	Computes a table containing the values of each pixel
  !	of the 2 input images (i.e., the cross histogram is
  !	represented by a scatter of points)
  !
  ! Arguments :
  !	Z	R*4(*)	First input image
  !	Y	R*4(*)	Second input image
  !	NX	I	First dimension of input images
  !	NY	I	Second dimension of input images
  !	BVALY	R*4	Blanking value of input Y image
  !	EVALY	R*4	Tolerance on blanking value
  !	BVALZ	R*4	Blanking value of input Z image
  !	EVALZ	R*4	Tolerance on blanking value
  !	H	R*4(*)	Result Table
  !---------------------------------------------------------------------
  integer(kind=size_length) :: nxy    !
  real*4 :: z(nxy)                   !
  real*4 :: y(nxy)                  !
  real*4 :: bvaly                   !
  real*4 :: evaly                   !
  real*4 :: bvalz                   !
  real*4 :: evalz                   !
  integer(kind=size_length), intent(in)  :: nmax  ! Maximum size of table
  real*4 :: h(nmax,2)               !
  integer(kind=size_length), intent(out) :: nin   ! Current size of table
  ! Local
  integer(kind=size_length) :: i
  !
  nin=0
  if (evalz.ge.0.0) then
    if (evaly.ge.0.0) then
      do i=1,nxy
        if (abs(z(i)-bvalz).gt.evalz .and.   &
   &            abs(y(i)-bvaly).gt.evaly) then
          nin = nin+1
          h(nin,1)=z(i)
          h(nin,2)=y(i)
        endif
      enddo
    else
      do i=1,nxy
        if (abs(z(i)-bvalz).gt.evalz) then
          nin = nin+1
          h(nin,1)=z(i)
          h(nin,2)=y(i)
        endif
      enddo
    endif
  else
    if (evaly.ge.0.0) then
      do i=1,nxy
        if (abs(y(i)-bvaly).gt.evaly) then
          nin = nin+1
          h(nin,1)=z(i)
          h(nin,2)=y(i)
        endif
      enddo
    else
      do i=1,nxy
        nin = nin+1
        h(nin,1)=z(i)
        h(nin,2)=y(i)
      enddo
    endif
  endif
end subroutine cloud001
