program field_stat
  use gildas_def
  use image_def
  use gbl_format
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! GILDAS	Stand alone program
  ! 	Compute statistics on a number of fields for an input 3-D
  ! 	image, and a label image
  ! 	Results : a Table with the average spectra for each field if
  ! 	the input is 3-D.
  !---------------------------------------------------------------------
  ! Local
  character(len=filename_length) :: namex,namey,namet
  logical :: error
  integer :: nfields, ier
  type(gildas) :: x,y,z
  !
  call gildas_open
  call gildas_char('Y_NAME$',namey)
  call gildas_char('X_NAME$',namex)
  call gildas_char('T_NAME$',namet)
  call gildas_inte('FIELD$',nfields,1)
  call gildas_close
  !
  call gildas_null(y)
  call gdf_read_gildas(y,namey,'.gdf',error, rank=3)
  if (error) then
    call gagout('F-FIELD_STAT,  Cannot read input file')
    goto 100
  endif
  !
  ! Read label image
  call gildas_null(x)
  ! Check rank
  call gdf_read_gildas(x,namex,'.gdf',error, rank=-2) 
  if (error)  goto 100
  !
  ! Check image consistency
  if (x%gil%dim(1).ne.y%gil%dim(1) .or. x%gil%dim(2).ne.y%gil%dim(2)) then
    call gagout('E-FIELD_STAT,  '   &
     &      //'Label image and data cube are not coincident')
    goto 100
  endif
  !
  ! Create output table
  call gildas_null(z, type = 'TABLE' ) 
  call sic_parsef(namet,z%file,' ','.tab')
  z%gil%dim(1) = y%gil%dim(3)
  z%gil%dim(2) = nfields*2+1
  allocate (z%r2d(z%gil%dim(1), z%gil%dim(2)), stat=ier)
  z%r2d = 0.0
  !
  call field003(y%r3d,                       & ! Input Cube
                y%gil%dim(1),y%gil%dim(2),y%gil%dim(3),   &  ! Cube dimensions
                x%r2d,                       &  ! Label
                y%gil%bval,y%gil%eval,       &  ! Blanking values
                z%r2d,                       &  ! Output Table
                z%gil%dim(1),z%gil%dim(2),   &
                nfields,                     &  ! Number of fields found
                ier)
  if (nfields.eq.0) then
    call gagout('W-FIELD,  No field found')
  elseif (nfields.eq.1) then
    call gagout('I-FIELD_STAT,  Found 1 field in image')
  else
    write(namex,'(A,I0,A)') 'I-FIELD_STAT,  Found ',nfields,' fields in image'
    call gagout(namex)
  endif
  if (ier.ne.0) call gagout('W-FIELD_STAT,  Too many fields')
  !
  call field004(z%r2d,z%gil%dim(1),y%gil%inc(3),y%gil%val(3),y%gil%ref(3))
  !
  ! Now create the output table
  call gdf_create_image(z,error)
  if (error) then
    call gagout('F-FIELD_STAT,  Cannot create output table')
    goto 100
  endif
  call gdf_write_data (z,z%r2d,error)
  if (error)  continue
  call gdf_close_image(z,error)
  if (error)  continue
  call sysexi(1)
  !
100 call sysexi (fatale)
end program field_stat
!
subroutine field003(z,nx,ny,nz,y,bval,eval,t,nl,nc,nfields,ier)
  use gildas_def
  integer(kind=index_length) :: nx                     !
  integer(kind=index_length) :: ny                     !
  integer(kind=index_length) :: nz                     !
  integer(kind=index_length) :: nl                     !
  integer(kind=index_length) :: nc                     !
  real :: z(nx,ny,nz)               !
  real :: y(nx,ny)                  !
  real :: bval                      !
  real :: eval                      !
  real :: t(nl,nc)                  !
  integer :: nfields                !
  integer :: ier                    !
  ! Local
  integer :: i,j,k,label
  real :: value
  !
  ier = 0
  nfields = 0
  do k = 1,nz
    do j = 1,ny
      do i = 1,nx
        label = y(i,j)
        if (2*label+1.gt.nc) then
          ier = 1
        elseif (label.ne.0) then
          value = z(i,j,k)
          if (abs(value-bval).gt.eval) then
            t(k,2*label) = t(k,2*label)+1
            t(k,2*label+1) = t(k,2*label+1)+value
          endif
        endif
        nfields = max(nfields,label)
      enddo
    enddo
  enddo
end subroutine field003
!
subroutine field004(t,nl,xinc,xval,xref)
  use gildas_def
  integer(kind=index_length) :: nl   !
  real :: t(nl)                      !
  real(8) :: xinc                    !
  real(8) :: xval                    !
  real(8) :: xref                    !
  ! Local
  integer :: i
  !
  do i =1,nl
    t(i) = (i-xref)*xinc+xval
  enddo
end subroutine field004
