program table_margin
  use gildas_def
  use gbl_format
  use image_def
  use gkernel_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! GILDAS	Stand alone program
  !
  !	  Marginalize a table of values depending of n (> 2) variables
  ! to obtain a table of values of 2 variables. The marginalization
  ! can be by selecting the Min (appropriate for Chi^2), the Max
  ! (appropriate for Likelikhood) the Mean or the Sum.
  !---------------------------------------------------------------------
  ! Global
  character(len=*), parameter :: rname = 'MARGINALIZE'
  integer, parameter :: code_min=1, code_max=2, code_sum=3, code_mean=4
  ! Local
  real :: blank
  integer :: cols(3)
  logical :: error
  integer :: i, code
  character(len=filename_length) :: iname, oname
  character(len=12) :: algo
  character(len=120) :: mess  
  type(gildas) :: hin, hout
  !
  ! Open parameter file
  call gildas_open
  call gildas_char('TABLE_IN$',iname)
  call gildas_char('TABLE_OUT$',oname)
  call gildas_inte('COLUMNS$',cols,3)
  call gildas_char('METHOD$',algo)
  call gildas_real('BLANKING$',blank,1)
  call gildas_close
  !
  call gildas_null(hin, type='TABLE')
  !
  hin%loca%read = .false.
  call gdf_read_gildas(hin,iname,'.tab',error,data=.true.)
  if (error) then
    call gag_message(seve%e,rname,'Cannot read input file')
    call sysexi(fatale)
  endif
  do i=1,3
    if (cols(i).lt.1 .or. cols(i).gt.hin%gil%dim(2)) then
      write(mess,'(A,I0,A)') 'Column ',i,' does not exist'
      call gag_message(seve%e,rname,mess)
      error = .true.
    endif
  enddo
  if (error) call sysexi (fatale)
  call sic_upper(algo)
  select case(algo)
  case ('MIN')
    code = code_min
  case ('MAX')
    code = code_max
  case ('SUM')
    code = code_sum    
  case ('MEAN')
    code = code_mean
  case default
    code = 0
    call gag_message(seve%e,rname,'Invalid method '//algo)
    call sysexi(fatale)
  end select
  !
  call gildas_null(hout, type='TABLE')
  hout%gil%bval = blank
  !
  call sub_table_margin(hin,hout,cols(1),cols(2),cols(3),code,error)
  if (error) call sysexi(fatale)
  !
  call sic_parsef(oname,hout%file,' ','.tab')
  call gdf_write_image(hout,hout%r2d,error)
  if (error) call sysexi(fatale)
  call gagout ('S-'//rname//', Succesful completion')
  !
contains
!
subroutine sub_table_margin(hin,hout,ipx,ipy,ipz,code,error)
  use image_def
  use gbl_message
  use gkernel_interfaces
  !
  type(gildas), intent(in) :: hin     ! Input table
  type(gildas), intent(inout) :: hout ! Output table
  integer, intent(in) :: ipx,ipy,ipz  ! Column pointers
  integer, intent(in) :: code         ! Marginalization code
  logical, intent(inout) :: error     ! Error flag
  !
  character(len=*), parameter :: rname = 'TABLE_PROJECT'
  integer, parameter :: maxsiz=8192**2
  ! Local
  integer(kind=size_length) :: ixy
  integer :: nfx,nfy,ier
  real(8) :: incx,incy
  real(8) :: xmin,xmax,ymin,ymax
  real(8) :: conv(6)
  real(4) :: blank, cblank, eblank
  !
  ! We need a Blanking value, specified in hout%gil%blank
  eblank = -1.0
  cblank = hout%gil%bval ! Does not matter
  blank = hout%gil%bval
  !
  ixy = hin%gil%dim(1)
  call find_inc4(hin%r2d(:,ipx),ixy,xmin,xmax,incx,eblank,cblank)
  call find_inc4(hin%r2d(:,ipy),ixy,ymin,ymax,incy,eblank,cblank)
  !
  ! Find Map size
  nfx  = nint((xmax-xmin)/abs(incx))+1
  nfy  = nint((ymax-ymin)/abs(incy))+1
  if (nfx.le.1 .or. nfy.le.1) then
    call gag_message(seve%e,rname,'No resulting projection')
    Print *,'X ',xmin,xmax,incx, nfx
    Print *,'Y ',ymin,ymax,incy, nfy
    error = .true.
  else if (int(nfx,8)*int(nfy,8).gt.maxsiz**2) then
    call gag_message(seve%e,rname,'Unrealistically large projection')
    call gag_message(seve%e,rname,'Perhaps data is not regularly spaced')
    error = .true.
  endif
  if (error) return
  !
  ! Axis conversion semigroup
  conv(1)=1.0d0
  conv(2)=xmin
  conv(3)=abs(incx)
  conv(4)=1.0d0
  conv(5)=ymin
  conv(6)=abs(incy)
  !
  hout%gil%dim(1) = nfx*nfy
  hout%gil%dim(2) = 3
  allocate(hout%r2d(nfx*nfy,3),stat=ier)
  if (ier.ne.0) then
    call gag_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  ! Computes RGDATA and update several CONPLOT common values
  call rgfromxyz(hout%r2d,nfx,nfy, &
    & hin%r2d(:,ipx),hin%r2d(:,ipy),hin%r2d(:,ipz), &
    & ixy,conv,eblank,cblank,blank,code)
  !
  ! Write the output Table in caller 
end subroutine sub_table_margin
!
subroutine rgfromxyz(rg,nx,ny,x,y,z,n,conv,eb,cb,b,key)
  use gildas_def
  !---------------------------------------------------------------------
  ! Puts Z=F(X,Y) if X and Y are not in a blanked interval;
  !   Z=B where no X,Y
  !---------------------------------------------------------------------
  integer, intent(in)  :: nx                   ! X grid size
  integer, intent(in)  :: ny                   ! Y grid size
  real(4), intent(out)  :: rg(nx,ny,3)         ! Gridded values
  integer(kind=size_length), intent(in) :: n   ! Number of points
  real(4), intent(in)  :: x(n)                 !
  real(4), intent(in)  :: y(n)                 !
  real(4) , intent(in) :: z(n)                 !
  real(8), intent(in)  :: conv(6)              ! Conversion formula
  real(4), intent(in)  :: eb                   ! Blanking tolerance
  real(4), intent(in)  :: cb                   ! Blanking
  real(4), intent(in)  :: b                    ! Default value
  integer, intent(in) :: key  ! Reduction Operation code
  !
  integer, parameter :: code_min=1, code_max=2, code_sum=3, code_mean=4
  ! Local
  integer :: i,j
  integer(kind=size_length) :: k
  integer :: ip(nx,ny)  ! Automatic array
  real(8) :: l1,l2
  integer :: code
  !
  rg(:,:,3) = b
  ip(:,:) = 0
  !
  code = key
  if (key.eq.code_mean) code=code_sum
  !
  if (eb.lt.0.0d0) then
    do k=1,n
      l1=(x(k)-conv(2))/conv(3) + conv(1)
      i=nint(l1)
      l2=(y(k)-conv(5))/conv(6) + conv(4)
      j=nint(l2)      
      if (ip(i,j).eq.0) then
        rg(i,j,1)=x(k)
        rg(i,j,2)=y(k)
        rg(i,j,3)=z(k)
        ip(i,j)=1
      else
        if (code.eq.code_min) then
          rg(i,j,3) = min(rg(i,j,3),z(k))
        else if (code.eq.code_max) then
          rg(i,j,3) = max(rg(i,j,3),z(k))
        else if (code.eq.code_sum) then
          rg(i,j,3) = rg(i,j,3) + z(k)
          ip(i,j)= ip(i,j)+1
        endif
      endif
    enddo
  else
    do k=1,n
      if (abs(x(k)-cb).gt.eb.or.abs(y(k)-cb).gt.eb) then
        l1=(x(k)-conv(2))/conv(3) + conv(1)
        i=nint(l1)
        l2=(y(k)-conv(5))/conv(6) + conv(4)
        j=nint(l2)
        if (ip(i,j).eq.0) then
          rg(i,j,1)=x(k)
          rg(i,j,2)=y(k)
          rg(i,j,3)=z(k)
          ip(i,j)=1
        else
          if (code.eq.code_min) then
            rg(i,j,3) = min(rg(i,j,3),z(k))
          else if (code.eq.code_max) then
            rg(i,j,3) = max(rg(i,j,3),z(k))
          else if (code.eq.code_sum) then
            rg(i,j,3) = rg(i,j,3) + z(k)
            ip(i,j)= ip(i,j)+1
          endif
        endif
      endif
    enddo
  endif
  !
  if (key.eq.code_mean) then
    do j=1,ny
      do i=1,nx
        if (ip(i,j).ne.0) then
          rg(i,j,3) = rg(i,j,3)/ip(i,j)
        endif
      enddo
    enddo
  endif
end subroutine rgfromxyz
!
subroutine find_inc4 (input,ixy,xmin,xmax,xinc,eblank,cblank)
  use gildas_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Find the increment from X,Y values which are regularly sampled
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in) :: ixy  ! Number of values
  real(4), intent(in) :: input(ixy)             ! Values
  real(8), intent(out) :: xmin                  ! Minimum
  real(8), intent(out)  :: xmax                 ! Maximum
  real(8), intent(out)  :: xinc                 ! Step
  real(4), intent(in) :: eblank                 ! Blanking tolerance
  real(4), intent(in) :: cblank                 ! Blanking
  ! Local
  real(4), allocatable :: value(:) 
  integer(kind=size_length) :: nval,i,j,nmin,nmax
  integer :: ier
  real(4) :: rmin,rmax
  real(8) :: l1,l2
  logical :: found
  !
  nval = 1
  allocate (value(ixy), stat=ier)
  value(1) = input(1)
  !
  do i=2,ixy
    found = .false.
    do j=1,nval
      if (input(i).eq.value(j)) then
        found = .true.
        exit
      endif
    enddo
    if (.not.found) then
      nval  = nval+1
      value(nval) = input(i)
    endif
  enddo
  !
  call gr4_minmax(nval,value,cblank,eblank,rmin,rmax,nmin,nmax)
  xmin = rmin
  xmax = rmax
  !
  xinc = xmax-xmin
  if (eblank.lt.0.0d0) then
    do i=1,nval-1
      l1=value(i)
      do j=i+1,nval
        l2 = value(j)
        xinc = min(xinc,abs(l1-l2))
      enddo
    enddo
  else
    do i=1,nval-1
      l1=value(i)
      if (abs(l1-cblank).gt.eblank) then
        do j=i+1,nval
          l2 = value(j)
          if (abs(l2-cblank).gt.eblank) then
            xinc = min(xinc,abs(l1-l2))
          endif
        enddo
      endif
    enddo
  endif
  deallocate (value)
end subroutine find_inc4

end program table_margin
