program list
  use gildas_def
  use image_def
  use gbl_format
  use gkernel_interfaces
  ! Local
  integer :: iline,jline,icol,jcol,ier
  logical :: error
  character(len=filename_length) :: namex,namey,file
  type(gildas) :: x
  !
  call gildas_open
  call gildas_char('FILE$',namex)
  call gildas_char('LIST$',namey)
  call gildas_inte('FIRST_LINE$',iline,1)
  call gildas_inte('LAST_LINE$',jline,1)
  call gildas_inte('FIRST_COLUMN$',icol,1)
  call gildas_inte('LAST_COLUMN$',jcol,1)
  call gildas_close
  !
  call gildas_null(x, type = 'TABLE')
  x%gil%form = 0  ! Prepare to accept any format
  call gdf_read_gildas (x,namex,'.tab',error, data=.false.)
  if (error) then
    write(6,*) 'E-LIST,  Cannot read input table'
    goto 100
  endif
 
  !
  call sic_parsef(namey,file,' ','.dat')
  ier = sic_open (1,file,'NEW',.false.)
  if (ier.ne.0) then
    write(6,*) 'E-LIST,  Cannot create output file'
    call putios('E-LIST,  ',ier)
    goto 100
  endif
  write(6,*) 'I-LIST,  Input file has ',x%gil%dim(2), &
    &   ' columns and ',x%gil%dim(1),' lines'
  !
  iline = max(1,min(iline,x%gil%dim(1)))
  jline = min(jline,x%gil%dim(1))
  if (jline.le.0) jline = x%gil%dim(1)
  !
  icol = max(1,min(icol,x%gil%dim(2)))
  jcol = min(jcol,x%gil%dim(2))
  if (jcol.le.0) jcol = x%gil%dim(2)
  !
  x%blc(2) = icol
  x%trc(2) = jcol
  ! Trick here: we will allocate only the minimum size needed
  jcol = jcol-icol+1
  icol = 1
  if (x%gil%form.eq.fmt_r4) then
    allocate(x%r2d(x%gil%dim(1),jcol),stat=ier)
    call gdf_read_data(x,x%r2d,error)
    call list_r4(x%r2d,x%gil%dim(1),jcol,iline,jline,icol,jcol)
  elseif (x%gil%form.eq.fmt_r8) then
    allocate(x%d2d(x%gil%dim(1),jcol),stat=ier)
    call gdf_read_data(x,x%d2d,error)
    call list_r8(x%d2d,x%gil%dim(1),jcol,iline,jline,icol,jcol)
  elseif (x%gil%form.eq.fmt_i4) then
    allocate(x%i2d(x%gil%dim(1),jcol),stat=ier)
    call gdf_read_data(x,x%i2d,error)
    call list_i4(x%i2d,x%gil%dim(1),jcol,iline,jline,icol,jcol)
  endif
  call gagout ('S-LIST,  Successful completion')
  call sysexi (1)
100 call sysexi (fatale)
end program list
!
subroutine list_r4(x,n,m,ifirst,ilast,ic,lc)
  use gildas_def
  integer(kind=index_length), intent(in) :: n             ! Number of lines
  integer(kind=4),            intent(in) :: m             ! Number of columns
  real(kind=4),               intent(in) :: x(n,m)        ! The array
  integer(kind=4),            intent(in) :: ifirst,ilast  ! Line range
  integer(kind=4),            intent(in) :: ic,lc         ! Column range
  ! Local
  character(len=20) :: forma
  integer(kind=4) :: i,j
  !
  ! "-1.234567E-12" => 13 chars, 6 digits
  write(forma,'(A,I0,A)')  '(',lc-ic+1,'(1X,1PG13.6))'
  !
  do i=ifirst,ilast
    write(1,forma) (x(i,j),j=ic,lc)
  enddo
end subroutine list_r4
!
subroutine list_r8(x,n,m,ifirst,ilast,ic,lc)
  use gildas_def
  integer(kind=index_length), intent(in) :: n             ! Number of lines
  integer(kind=4),            intent(in) :: m             ! Number of columns
  real(kind=8),               intent(in) :: x(n,m)        ! The array
  integer(kind=4),            intent(in) :: ifirst,ilast  ! Line range
  integer(kind=4),            intent(in) :: ic,lc         ! Column range
  ! Local
  character(len=20) :: forma
  integer(kind=4) :: i,j
  !
  ! "-1.234567890123E-123" => 20 chars, 12 digits
  write(forma,'(A,I0,A)')  '(',lc-ic+1,'(1X,1PG20.12))'
  !
  do i=ifirst,ilast
    write(1,forma) (x(i,j),j=ic,lc)
  enddo
end subroutine list_r8
!
subroutine list_i4(x,n,m,ifirst,ilast,ic,lc)
  use gildas_def
  integer(kind=index_length), intent(in) :: n             ! Number of lines
  integer(kind=4),            intent(in) :: m             ! Number of columns
  integer(kind=4),            intent(in) :: x(n,m)        ! The array
  integer(kind=4),            intent(in) :: ifirst,ilast  ! Line range
  integer(kind=4),            intent(in) :: ic,lc         ! Column range
  ! Local
  character(len=20) :: forma
  integer(kind=4) :: i,j
  !
  ! -2**32 = -2147483648 => 11 chars
  write(forma,'(A,I0,A)')  '(',lc-ic+1,'(1X,I11))'
  !
  do i=ifirst,ilast
    write(1,forma) (x(i,j),j=ic,lc)
  enddo
end subroutine list_i4
