program slice
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gkernel_types
  !---------------------------------------------------------------------
  ! GILDAS
  !     Arbitray slice in a 3-D data set, using bilinear interpolation
  ! F.Badia
  !---------------------------------------------------------------------
  ! Global
  integer, external :: pix_axis
  ! Local
  character(len=filename_length) :: mapdata,mapsort
  character(len=80) :: radec_start,radec_end
  integer :: axe,n,ier
  logical :: error
  real(4), allocatable :: lgu(:), mgu(:)
  integer :: istart(2), iend(2), ispace
  integer :: npoints
  real(8) :: dstart(2), dend(2), dl, dm, dx, dy,ang
  real(8) :: user1,user2
  character(len=24) :: ra_start, dec_start, ra_end, dec_end
  real(8) :: ustart(2), uend(2)
  type(gildas) :: x,y
  type(projection_t) :: proj
  !
  ! Code:
  call gildas_open
  call gildas_char('INPUT_MAP$',mapdata)
  call gildas_char('OUTPUT_MAP$',mapsort)
  call gildas_char('START$',radec_start)
  call gildas_char('END$',radec_end)
  call gildas_close
  !
  ! Input file
  n = len_trim(mapdata)
  if (n.le.0) goto 999
  call gildas_null(y)
  y%gil%ndim = 3
  call gdf_read_gildas(y,mapdata,'.lmv',error, data=.false.)
  if (error) then
    call gagout('F-SLICE,  Cannot read input data cube')
    goto 999
  endif
  !
  call gwcs_projec(y%gil%a0,y%gil%d0,y%gil%pang,y%gil%ptyp,proj,error)
  if (error)  goto 999
  n = len_trim(radec_start)
  ispace = index(radec_start, ' ')
  ra_start = radec_start(1:ispace)
  dec_start = radec_start(ispace+1:n)
  n = len_trim(radec_end)
  ispace = index(radec_end, ' ')
  ra_end = radec_end(1:ispace)
  dec_end = radec_end(ispace+1:n)
  call sic_decode(ra_start,ustart(1),24,error)
  if (error) then
    call gagout('F-SLICE,  Error in SIC_DECODE')
    goto 999
  endif
  call sic_decode(dec_start,ustart(2),360,error)
  if (error) then
    call gagout('F-SLICE,  Error in SIC_DECODE')
    goto 999
  endif
  call sic_decode(ra_end,uend(1),24,error)
  if (error) then
    call gagout('F-SLICE,  Error in SIC_DECODE')
    goto 999
  endif
  call sic_decode(dec_end,uend(2),360,error)
  if (error) then
    call gagout('F-SLICE,  Error in SIC_DECODE')
    goto 999
  endif
  call abs_to_rel(proj,ustart(1), ustart(2), user1, user2, 1)
  istart(1) = pix_axis(y,user1,1)
  istart(2) = pix_axis(y,user2,2)
  call abs_to_rel(proj,uend(1), uend(2), user1, user2, 1)
  iend(1) = pix_axis(y,user1,1)
  iend(2) = pix_axis(y,user2,2)
  !
  n = len_trim(mapsort)
  if (n.le.0) goto 999
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  !
  call sic_parsef(mapsort,x%file,' ','.lmv')
  dstart(1) = dble(istart(1))
  dstart(2) = dble(istart(2))
  dend(1) = dble(iend(1))
  dend(2) = dble(iend(2))
  !
  ! Define number of points
  if (dstart(1).eq.dend(1)) then
    axe = 2
    dx = 0.
    dy = 1.
    npoints = dabs(dend(2) - dstart(2)) + 1.
  elseif (dstart(2).eq.dend(2)) then
    axe = 1
    dx = 1.
    dy = 0.
    npoints = dabs(dend(1) - dstart(1)) + 1.
  else
    axe = 0
    dl = dabs(dend(1)-dstart(1)) + 1.
    dm = dabs(dend(2)-dstart(2)) + 1.
    npoints = sqrt(dl*dl + dm*dm)
    dx = dl/dble(npoints)
    dy = dm/dble(npoints)
    ang = atan2(dx*y%gil%inc(1),dy*y%gil%inc(2))
  endif
  !
  allocate (lgu(npoints), mgu(npoints), stat=ier)
  if (ier.ne.0) goto 999
  if (dend(1).lt.dstart(1)) then
    dx = -dx
  endif
  if (dend(2).lt.dstart(2)) then
    dy = -dy
  endif
  !
  !     Allocate arrays for slice coordinates
  call fill_gu(lgu, dstart(1), dx, npoints)
  call fill_gu(mgu, dstart(2), dy, npoints)
  !
  allocate(y%r3d(y%gil%dim(1),y%gil%dim(2),y%gil%dim(3)), stat=ier)
  call gdf_read_data(y,y%r3d,error)
  if (error) goto 999
  !
  x%gil%dim(1) = npoints
  x%gil%dim(2) = y%gil%dim(3)
  x%gil%dim(3) = 1
  x%gil%ndim = 2
  x%loca%size = x%gil%dim(1)*x%gil%dim(2)
  x%char%code(2) = y%char%code(3)
  x%gil%yaxi = 3
  x%gil%faxi = 2
  x%char%code(3) = 'UNKNOWN'
  !
  x%gil%convert(:,2) = y%gil%convert(:,3)
  x%gil%convert(1,1) = 1.D0
  x%gil%convert(2,1) = 0.D0
  if (axe.ne.0) then
    x%char%code(1) = y%char%code(axe)
    x%gil%inc(1) =  y%gil%inc(axe)
    x%gil%xaxi = y%gil%xaxi
  else
    x%char%code(1) = 'ANGLE'
    x%gil%xaxi = 1
    x%gil%pang = ang
    x%gil%inc(1) = sqrt((dx*y%gil%inc(1))**2 + (dy*y%gil%inc(2))**2)
  endif
  x%gil%ref(1) = 1.
  x%gil%val(1) = 0.
  x%gil%extr_words = 0
  !
  user1 = (lgu(1)-y%gil%ref(1))*y%gil%inc(1) + y%gil%val(1)
  user2 = (mgu(1)-y%gil%ref(2))*y%gil%inc(2) + y%gil%val(2)
  call rel_to_abs(proj,user1, user2, x%gil%a0, x%gil%d0, 1)
  x%gil%convert(:,3) = 1.0d0
  !
  call gdf_create_image(x,error)
  if (error) goto 999
  allocate(x%r2d(x%gil%dim(1),x%gil%dim(2)), stat=ier)
  !
  if (y%gil%eval.eq.-1) then
    call do_slice(y%r3d, y%gil%dim(1), y%gil%dim(2), y%gil%dim(3),   &
     &      lgu, mgu,   &
     &      x%r2d, npoints, x%gil%bval)
  else
    write (6,*) 'with blanks'
    call do_sliceb(y%r3d, y%gil%dim(1), y%gil%dim(2), y%gil%dim(3),   &
     &      lgu, mgu,   &
     &      x%r2d, npoints, x%gil%bval)
  endif
  !
  print *,'BLC ',x%blc
  print *,'TRC ',x%trc
  call gdf_write_data(x,x%r2d,error)
  call gagout('S-SLICE,  Successful completion')
  call sysexi(1)
999 call sysexi(fatale)
end program slice
!
subroutine do_slice(in, nx, ny, nc, x, y, out, np, blank)
  use gildas_def
  integer(kind=index_length) :: nx                     !
  integer(kind=index_length) :: ny                     !
  integer(kind=index_length) :: nc                     !
  real :: in(nx,ny,nc)              !
  integer :: np                     !
  real :: x(np)                     !
  real :: y(np)                     !
  real :: out(np,nc)                !
  real :: blank                     !
  ! Local
  real :: dx,dy
  integer :: ic,n,i,j
  !
  do ic=1,nc
    do n=1,np
      i = int(x(n))
      j = int(y(n))
      dx = x(n) - float(i)
      dy = y(n) - float(j)
      if((i.lt.1).or.(j.lt.1).or.(i.ge.nx).or.(j.ge.ny))then
        !              Interpolated point outside input image
        out(n, ic) = blank
      else
        out(n,ic) = dx * dy * in(i+1, j+1, ic)   &
     &          + (1.0 - dx) * dy * in(i, j+1, ic)   &
     &          + (1.0 - dx) * (1.0 - dy) * in(i, j, ic)   &
     &          + dx * (1.0 - dy) * in(i+1, j, ic)
      endif
    enddo
  enddo
end subroutine do_slice
!
subroutine do_sliceb(in, nx, ny, nc, x, y, out, np, blank)
  use gildas_def
  integer(kind=index_length) :: nx                     !
  integer(kind=index_length) :: ny                     !
  integer(kind=index_length) :: nc                     !
  real :: in(nx,ny,nc)              !
  integer :: np                     !
  real :: x(np)                     !
  real :: y(np)                     !
  real :: out(np,nc)                !
  real :: blank                     !
  ! Local
  real :: dx,dy,coeff(4)
  integer :: ic,n,i,j,k
  !
  do ic=1,nc
    do n=1,np
      i = int(x(n))
      j = int(y(n))
      dx = x(n) - float(i)
      dy = y(n) - float(j)
      if((i.lt.1).or.(j.lt.1).or.(i.ge.nx).or.(j.ge.ny))then
        !             Interpolated point outside input image'
        out(n, ic) = blank
        continue
      else
        do k = 1, 4
          coeff(k) = 1.0
        enddo
        if (in(i, j, ic).eq.blank) then
          if ((dx.le.0.5).and.(dy.le.0.5)) then
            out(n, ic) = blank
            continue
          else
            coeff(1) = 0.
          endif
        endif
        if (in(i+1, j, ic).eq.blank) then
          if ((dx.gt.0.5).and.(dy.le.0.5)) then
            out(n, ic) = blank
            continue
          else
            coeff(2) = 0.
          endif
        endif
        if (in(i, j+1, ic).eq.blank) then
          if ((dx.le.0.5).and.(dy.gt.0.5)) then
            out(n, ic) = blank
            continue
          else
            coeff(3) = 0.
          endif
        endif
        if (in(i+1, j+1, ic).eq.blank) then
          if ((dx.gt.0.5).and.(dy.gt.0.5)) then
            out(n, ic) = blank
            continue
          else
            coeff(4) = 0.
          endif
        endif
        out(n,ic) =   &
     &          (1.0 - dx) * (1.0 - dy) * coeff(1) * in(i, j, ic)   &
     &          + dx * (1.0 - dy) * coeff(2) * in(i+1, j, ic)   &
     &          + (1.0 - dx) * dy * coeff(3) * in(i, j+1, ic)   &
     &          + dx * dy * coeff(4) * in(i+1, j+1, ic)
      endif
    enddo
  enddo
end subroutine do_sliceb
!
subroutine fill_gu(ipgu, ds, dt, np)
  integer :: np                     !
  real :: ipgu(np)                  !
  real(8) :: ds                      !
  real(8) :: dt                      !
  ! Local
  integer :: n
  real(8) :: t
  !
  t = ds
  do n=1,np
    ipgu(n) = t
    t = t + dt
  enddo
end subroutine fill_gu
!
function pix_axis (head, user, iaxis)
  use image_def
  real(8), intent(in) :: user       ! User coordinates
  type(gildas), intent(in) :: head  ! Image header
  integer, intent(in) :: iaxis      ! Axis
  integer :: pix_axis ! intent(out) ! corresponding pixel 
  !
  ! Test error...
  if (iaxis.gt.gdf_maxdims) then
    pix_axis = 0
    return
  endif
  pix_axis = nint( (user - head%gil%val(iaxis)) /  &
        head%gil%inc(iaxis) + head%gil%ref(iaxis) )
end function pix_axis
