program table_density
  use gildas_def
  use gkernel_interfaces
  ! Purpose:
  !   Computes a 2-D array holding the density of points
  !   from 2 columns of a table
  character(len=filename_length) :: table, image, output
  integer(kind=4) :: cols(2),dims(2)
  real :: percent
  logical error
  !
  call gildas_open
  call gildas_char('NAME_IN$',table)
  call gildas_inte('COLS$',cols,2)
  call gildas_char('NAME_OUT$',image)
  call gildas_inte('DIMS$',dims,2)
  call gildas_char('TABLE_OUT$',output)
  call gildas_real('PERCENT$',percent,1)
  call gildas_close
  !
  call sub_table_density(table,cols,image,dims,output,percent,error)
end program
!
subroutine sub_table_density(table,cols,image,dims,output,percent,error)
  use image_def
  use gbl_message
  use gkernel_interfaces
  !
  character(len=*), intent(inout) :: table, image, output
  integer(kind=4), intent(in) :: cols(2),dims(2)
  real, intent(in) :: percent
  logical, intent(out) :: error
  !
  character(len=*), parameter :: rname='TABLE_DENSITY'
  integer(kind=size_length) :: nxy,nmin,nmax
  real :: xmin, xmax, ymin, ymax, dmin, dmax, bval, eval
  real(8) :: incx, incy 
  integer :: i,j,k,l, ier
  type(gildas) :: tab, img, tbl
  real, allocatable :: xx(:),yy(:)
  !
  call gildas_null(tab,type='TABLE')
  call gdf_read_gildas(tab,table,'.tab',error,data=.false.)
  if (error) return
  !
  if (cols(1).gt.tab%gil%dim(2) .or. cols(2).gt.tab%gil%dim(2)) then
    call gag_message(seve%e,rname,'Columns out of bound')
    error = .true.
    return
  endif
  !
  nxy = tab%gil%dim(1)
  allocate (xx(nxy),yy(nxy),stat=ier)
  if (ier.ne.0) then
    call gag_message(seve%e,rname,'TABLE allocation error')
    error = .true.
    return
  endif
  tab%blc(2) = cols(1)
  tab%trc(2) = cols(1)
  call gdf_read_data(tab,xx,error)
  if (error) return
  tab%blc(2) = cols(2)
  tab%trc(2) = cols(2)
  call gdf_read_data(tab,yy,error)
  if (error) return  
  !
  bval = 0.0
  eval = -1.0
  call gr4_extrema (nxy,xx,bval,eval,xmin,xmax,nmin,nmax)
  call gr4_extrema (nxy,yy,bval,eval,ymin,ymax,nmin,nmax)
  !
  ! Now compute the density
  call gildas_null(img)
  call sic_parse_file(image,' ','.gdf',img%file)
  !
  img%gil%ndim = 2
  img%gil%dim(1) = dims(1)
  img%gil%dim(2) = dims(2)
  incx = (xmax-xmin)/(dims(1)-1)
  incy = (ymax-ymin)/(dims(2)-1)
  ! Axis conversion semigroup
  img%gil%convert(1,1)=1.0d0
  img%gil%convert(2,1)=xmin
  img%gil%convert(3,1)=incx
  img%gil%convert(1,2)=1.0d0
  img%gil%convert(2,2)=ymin
  img%gil%convert(3,2)=incy
  allocate(img%r2d(dims(1),dims(2)),stat=ier)
  if (ier.ne.0) then
    call gag_message(seve%e,rname,'DATA allocation error')
    error = .true.
    return
  endif
  !
  img%r2d = 0.0
  !
  ! Loop on entries
  do k=1,nxy
    i = nint ( (xx(k)-img%gil%val(1))/img%gil%inc(1) + img%gil%ref(1))
    j = nint ( (yy(k)-img%gil%val(2))/img%gil%inc(2) + img%gil%ref(2))
    if (i.ge.1 .and. i.le.dims(1) .and. j.ge.1 .and. j.le.dims(2)) then
      img%r2d(i,j) = img%r2d(i,j)+1
    else
      Print *,'invalid point ',k,xx(k),xmax,yy(k),ymax,i,j
    endif
  enddo
  !
  call gdf_write_image(img,img%r2d,error)
  if (error) return
  !
  ! Retain only points below some threshold  
  call gr4_extrema (img%loca%size,img%r2d,bval,eval,dmin,dmax,nmin,nmax)
  dmax = percent*dmax/100.
  !
  l = 0
  do k=1,nxy
    i = nint ( (xx(k)-img%gil%val(1))/img%gil%inc(1) + img%gil%ref(1))
    j = nint ( (yy(k)-img%gil%val(2))/img%gil%inc(2) + img%gil%ref(2))
    if (img%r2d(i,j).lt.dmax) then
      l = l+1
      xx(l) = xx(k)
      yy(l) = yy(k)
    endif
  enddo
  deallocate(img%r2d)
  if (l.eq.0) then
     Print *,'Threshold is too low, no data selected'
     l = nxy
  endif
  !
  call gildas_null(tbl, type='TABLE')
  call sic_parse_file(output,' ','.tab',tbl%file)
  tbl%gil%dim(1) = l
  tbl%gil%dim(2) = 2
  tbl%gil%ndim = 2
  allocate(tbl%r2d(l,2),stat=ier)
  tbl%r2d(:,1) = xx(1:l)
  tbl%r2d(:,2) = yy(1:l)
  call gdf_write_image(tbl,tbl%r2d,error)
  if (error) return
  !
end subroutine sub_table_density
