program histo_simple
  use gildas_def
  use image_def
  use gbl_format
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! GDF	Main program for making a Histogram from a map
  ! Subroutines
  !	HISTO002
  !
  ! To be re-written for more efficiency: just extract the relevant
  ! part of the image first.
  !---------------------------------------------------------------------
  ! Local
  character(len=filename_length) :: namex,namey
  logical :: error
  real :: hmin,hmax,hstep
  integer, parameter :: mdim=4
  integer :: n, pmin(mdim), pmax(mdim), nh, ier
  type(gildas) :: x,y
  !
  call gildas_open
  call gildas_char('Y_NAME$',namey)
  call gildas_char('X_NAME$',namex)
  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_close
  !
  call gildas_null(y)
  y%blc(1:mdim) = pmin
  y%trc(1:mdim) = pmax
  !
  ! y%gil%form = fmt_r4 ! This is the default
  call gdf_read_gildas(y,namey,'.gdf',error,rank=0)
  if (error) goto 100
  if (y%gil%blan_words.eq.0) then
    y%gil%eval = -1.0
    y%gil%bval = 0.0
  endif
  !
  call gildas_null(x, type = 'TABLE' )
  n = lenc(namex)
  if (n.eq.0) goto 100
  call sic_parsef(namex(1:n),x%file,' ','.tab')
  x%gil%dim(1) = nh
  x%gil%dim(2) = 2
  hstep = (hmax-hmin)/(nh-1)
  !
  allocate (x%r2d(x%gil%dim(1),x%gil%dim(2)), stat=ier)
  call histo002(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_SIMPLE,  Successful completion')
  call sysexi (1)
  !
100 call sysexi (fatale)
end program histo_simple
!
subroutine histo002(y,ydim,bval,eval, x,nh,hmin,hstep)
  use gildas_def
  !---------------------------------------------------------------------
  ! GDF	Internal routine
  !	Computes the histogram of part of an image
  !---------------------------------------------------------------------
  integer(kind=size_length),  intent(in)    :: ydim     ! Input array size
  real(kind=4),               intent(in)    :: y(ydim)  ! Input array
  real(kind=4),               intent(in)    :: bval     ! Blanking
  real(kind=4),               intent(in)    :: eval     ! Tolerance
  integer(kind=index_length), intent(in)    :: nh       ! Histogram size
  real(kind=4),               intent(inout) :: x(nh,2)  ! Histogram values
  real(kind=4),               intent(in)    :: hmin     ! Min val
  real(kind=4),               intent(in)    :: hstep    ! Step
  ! Local
  integer(kind=size_length) :: i,n,ntot,nin,nout,nblank
  !
  nin = 0
  nout = 0
  nblank = 0
  x(:,1) = 0.0
  !
  if (eval.ge.0.0) then
    do i=1,ydim
      if (abs(y(i)-bval).gt.eval) then
        n = nint((y(i)-hmin)/hstep + 1.0)
        if (n.ge.1 .and. n.le.nh) then
          x(n,1) = x(n,1)+1.
          nin = nin+1
        else
          nout= nout+1
        endif
      else
        nblank = nblank+1
      endif
    enddo
  else
    do i=1,ydim
      n = nint((y(i)-hmin)/hstep + 1.0)
      if (n.ge.1 .and. n.le.nh) then
        x(n,1) = x(n,1)+1.
        nin = nin+1
      else
        nout= nout+1
      endif
    enddo
  endif  
  !
  ! Now fill the histogram definition
  do n=1,nh
    x(n,2) = hmin - hstep + n*hstep
  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 ',i12,4x,f4.1,' %',   &
     &    /,'   "    "    "    out of  "    ',i12,4x,f4.1,' %',   &
     &    /,'   "    "    "    blanked      ',i12,4x,f4.1,' %',   &
     &    /,'                  Total      = ',i12)
end subroutine histo002
