!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_slice
  use cubetools_structure
  use cubetools_keyword_arg
  use cube_types
  use cubeadm_cubeid_types
  use cubemain_messaging
  use cubemain_windowing
  use cubemain_spapos_types
  !
  public :: slice
  public :: cubemain_slice_command
  private
  !
  real(kind=coor_k), parameter :: spatol = 0.1 ! Spatial tolerance: 10% of a single pixel size
  !
  type :: slice_comm_t
     type(option_t), pointer  :: comm
     type(spapos_opt_t)       :: begin
     type(spapos_opt_t)       :: end
     type(option_t), pointer  :: posfile
     type(option_t), pointer  :: variable
     type(keyword_arg_t), pointer :: unit
   contains
     procedure, public  :: register      => cubemain_slice_register
     procedure, private :: parse         => cubemain_slice_parse
     procedure, private :: parse_posfile => cubemain_slice_parse_posfile
     procedure, private :: parse_var     => cubemain_slice_parse_variable
     procedure, private :: main          => cubemain_slice_main
  end type slice_comm_t
  type(slice_comm_t) :: slice
  !
  integer(kind=4), parameter :: icube = 1
  type slice_user_t
     type(cubeid_user_t)   :: cubeids
     type(spapos_user_t)   :: begin    ! [absolute|relative] position for the beginning of the slice
     type(spapos_user_t)   :: end      ! [absolute|relative] position for the end of the slice
     character(len=file_l) :: posfile  ! File with positions to be included on the slice
     logical               :: dofile   ! Should a file be used?
     character(len=varn_l) :: varname  ! Variable containing positions
     character(len=argu_l) :: unit     ! Unit of the values in the variable
     logical               :: dovar    ! Should a variable be used?
   contains
     procedure, private :: toprog => cubemain_slice_user_toprog
  end type slice_user_t
  type slice_prog_t
     type(cube_t), pointer :: cube                 ! Input cube
     type(cube_t), pointer :: slice                ! Output slice
     logical               :: dopoints             ! Is it a point slice?
     type(spapos_prog_t)   :: begin                ! [rad] Position of the beginning of the slice
     type(spapos_prog_t)   :: end                  ! [rad] Position of the end of the slice
     integer(kind=pixe_k)  :: np = 0               ! [---] Number of pixels in the slice
     real(kind=coor_k)     :: ang = 0d0            ! [rad] Angle of the slice  
     real(kind=coor_k)     :: dx = 0d0             ! [rad] Increment of the slice along the x axis 
     real(kind=coor_k)     :: dy = 0d0             ! [rad] Increment of the slice along the y axis
     real(kind=coor_k), allocatable :: pixels(:,:) ! [pix] Fractional pixels in the slice
   contains
     procedure, private :: precompute_pixels => cubemain_slice_prog_precompute_pixels
     procedure, private :: pixels_from_file  => cubemain_slice_prog_pixels_from_file
     procedure, private :: pixels_from_var   => cubemain_slice_prog_pixels_from_var
     procedure, private :: header            => cubemain_slice_prog_header
     procedure, private :: data              => cubemain_slice_prog_data
     procedure, private :: image_loop        => cubemain_slice_prog_image_loop
     procedure, private :: image             => cubemain_slice_prog_image
  end type slice_prog_t
  !
contains
  !
  subroutine cubemain_slice_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(slice_user_t) :: user
    character(len=*), parameter :: rname='SLICE>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call slice%parse(line,user,error)
    if (error) return
    call slice%main(user,error)
    if (error) continue
  end subroutine cubemain_slice_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_slice_register(slice,error)
    use cubetools_unit
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(inout) :: slice
    logical,             intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(keyword_arg_t) :: keyarg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: comm_abstract = &
         'Extract a 2D Position-Velocity slice from a cube'
    character(len=*), parameter :: comm_help = &
         'Extract a contiguous Position Velocity slice from cubname along the&
         & line that connects /BEGIN to /END, or a non contiguous Position &
         & velocity slice from points in a /VARIABLE or in a /POSFILE'
    character(len=*), parameter :: rname='SLICE>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'SLICE','[cube]',&
         comm_abstract,&
         comm_help,&
         cubemain_slice_command,&
         slice%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Signal cube',  &
         strg_id,&
         code_arg_optional,  &
         [flag_cube], &
         error)
    if (error) return
    !
    call slice%begin%register('BEGIN',&
         'Beginning point of the slice',&
         error)
    if (error) return
    !
    call slice%end%register('END',&
         'End point of the slice',&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'POSFILE','file',&
         'File with the position for the slice',&
         'Slices computed from a position file can be non contiguous.&
         & The slice will contain only the points described in the&
         & position file. The position file should be formatted as a&
         & series of lines, each line containing a single position.&
         & The syntax for describing a position is the same as the&
         & syntax for options /BEGIN and /END.',&
         slice%posfile,error)
    if (error) return
    call stdarg%register(&
         'file',&
         'Slice positions file',&
          strg_id,&
          code_arg_mandatory, error)
    if (error) return
    !
    call cubetools_register_option(&
         'VARIABLE','var [unit]',&
         'Variable containing positions for slice',&
         'The variable containing the positions must be REAL and have&
         & the shape [2,n], where n is the number of points in the&
         & slice nad the first dimension correspond to the x and y&
         & positions of each point. The points are assumed to be in&
         & relative coordinates from the projection center. The&
         & default unit for the coordinates is the current FOV unit,&
         & this can be changed with the optional argument unit',&
         slice%variable,error)
    if (error) return
    call stdarg%register(&
         'var',&
         'SIC variable containing positions',&
          strg_id,&
          code_arg_mandatory, error)
    if (error) return
    call keyarg%register(&
         'unit',&
         'Position coordinate unit',&
         strg_id,&
         code_arg_optional,&
         unit_fov_name,&
         .not.flexible,&
         slice%unit,&
         error)
    if (error) return
  end subroutine cubemain_slice_register
  !
  subroutine cubemain_slice_parse(slice,line,user,error)
    !----------------------------------------------------------------------
    ! SLICE cubname
    ! /BEGIN cx cy
    ! /END cx cy
    ! /POSFILE file
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(in)    :: slice
    character(len=*),    intent(in)    :: line
    type(slice_user_t),  intent(out)   :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SLICE>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,slice%comm,user%cubeids,error)
    if (error) return
    call slice%begin%parse(line,user%begin,error)
    if (error) return
    call slice%end%parse(line,user%end,error)
    if (error) return
    call slice%parse_posfile(line,user,error)
    if (error) return
    call slice%parse_var(line,user,error)
    if (error) return
    !
    if (user%dofile) then
       if (user%begin%do.or.user%end%do.or.user%dovar) then
          call cubemain_message(seve%e,rname,'Options /VARIABLE, /BEGIN and /END conflict with /POSFILE')
          error = .true.
          return
       endif
    else if (user%dovar) then
       if (user%begin%do.or.user%end%do.or.user%dofile) then
          call cubemain_message(seve%e,rname,'Options /POSFILE, /BEGIN and /END conflict with /VARIABLE')
          error = .true.
          return
       endif
    else      
       if (.not.user%begin%do) then
          call cubemain_message(seve%e,rname,'Option /BEGIN is mandatory')
          error = .true.
       endif
       if (.not.user%end%do) then
          call cubemain_message(seve%e,rname,'Option /END is mandatory')
          error = .true.
       endif
    endif
  end subroutine cubemain_slice_parse
  !
  subroutine cubemain_slice_parse_posfile(slice,line,user,error)
    !----------------------------------------------------------------------
    ! /POSFILE file
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(in)    :: slice
    character(len=*),    intent(in)    :: line
    type(slice_user_t),  intent(inout) :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SLICE>PARSE>POSFILE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call slice%posfile%present(line,user%dofile,error)
    if (error) return
    if (user%dofile) then
       call cubetools_getarg(line,slice%posfile,1,user%posfile,mandatory,error)
       if (error)  return
    endif
  end subroutine cubemain_slice_parse_posfile
  !
  subroutine cubemain_slice_parse_variable(slice,line,user,error)
    !----------------------------------------------------------------------
    ! /VARIABLE var [unit]
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(in)    :: slice
    character(len=*),    intent(in)    :: line
    type(slice_user_t),  intent(inout) :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SLICE>PARSE>VARIABLE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call slice%variable%present(line,user%dovar,error)
    if (error) return
    if (user%dovar) then
       call cubetools_getarg(line,slice%variable,1,user%varname,mandatory,error)
       if (error)  return
       user%unit = strg_star
       call cubetools_getarg(line,slice%variable,2,user%unit,.not.mandatory,error)
       if (error)  return
    endif
  end subroutine cubemain_slice_parse_variable
  !
  subroutine cubemain_slice_main(slice,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(in)    :: slice
    type(slice_user_t),  intent(inout) :: user
    logical,             intent(inout) :: error
    !
    type(slice_prog_t) :: prog
    character(len=*), parameter :: rname='SLICE>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) return
    call prog%header(error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubemain_slice_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_slice_user_toprog(user,prog,error)
    use cubedag_allflags
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_user_t), intent(in)    :: user
    type(slice_prog_t),  intent(out)   :: prog
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SLICE>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_get_header(slice%comm,icube,user%cubeids,code_access_imaset,code_read,prog%cube,error)
    if (error) return
    !
    prog%dopoints = user%dofile.or.user%dovar 
    if (user%dofile) then
       call prog%pixels_from_file(user%posfile,error)
       if (error) return
    else if (user%dovar) then
       call prog%pixels_from_var(user%varname,user%unit,error)
       if (error) return
    else
       !
       call user%begin%toprog(prog%cube,prog%begin,error)
       if (error) return
       call user%end%toprog(prog%cube,prog%end,error)
       if (error) return
       call prog%precompute_pixels(error)
       if (error) return
    endif
  end subroutine cubemain_slice_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_slice_prog_precompute_pixels(prog,error)
    use phys_const
    use gkernel_interfaces
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    logical :: constl,constm
    integer(kind=4) :: ier
    integer(kind=pixe_k) :: ipix,nl,nm
    real(kind=coor_k) :: dpl,dpm ! Increment in the l and m directions in pixels
    character(len=*), parameter :: rname='SLICE>PROG>PRECOMPUTE_PIXELS'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Define number of points
    constl = abs(prog%begin%frac(1)-prog%end%frac(1)).le.spatol*prog%cube%head%spa%l%inc
    constm = abs(prog%begin%frac(2)-prog%end%frac(2)).le.spatol*prog%cube%head%spa%m%inc
    if (constl.and.constm) then
       ! VVV This could be a single spectrum extraction?
       ! *** JP: Yes. Why is it an error?
       call cubemain_message(seve%e,rname,'Slice would contain a single pixel')
       error =.true.
       return
    elseif (constl) then
       dpl = 0.
       dpm = 1.
       prog%np = ceiling(abs(prog%end%frac(2)-prog%begin%frac(2)))+1
       prog%ang = 90*rad_per_deg
       prog%dx  =  prog%cube%head%spa%m%inc
       prog%dy  =  prog%cube%head%spa%l%inc
    elseif (constm) then
       dpl = 1.
       dpm = 0.
       prog%np = ceiling(abs(prog%end%frac(1)-prog%begin%frac(1)))+1
       prog%ang = 0.0
       prog%dx  =  prog%cube%head%spa%l%inc
       prog%dy  =  prog%cube%head%spa%m%inc
    else
       nl = ceiling(abs(prog%end%frac(1)-prog%begin%frac(1)))+1
       nm = ceiling(abs(prog%end%frac(2)-prog%begin%frac(2)))+1
       prog%np = sqrt(1d0*(nl*nl+nm*nm))
       dpl = nl/dble(prog%np)
       dpm = nm/dble(prog%np)
       prog%ang = atan2(dpl*prog%cube%head%spa%l%inc,dpm*prog%cube%head%spa%m%inc)
       prog%dx  =  sqrt((prog%cube%head%spa%l%inc*dpl)**2+(prog%cube%head%spa%m%inc*dpm)**2)
       prog%dy  =  prog%dx
    endif
    if (prog%end%frac(1).lt.prog%begin%frac(1)) dpl = -dpl
    if (prog%end%frac(2).lt.prog%begin%frac(2)) dpm = -dpm
    !
    allocate(prog%pixels(2,prog%np),stat=ier)
    if (failed_allocate(rname,'Pixel array',ier,error)) then
       error = .true.
       return
    endif
    do ipix=1,prog%np
       prog%pixels(1,ipix) = prog%begin%frac(1)+(ipix-1)*dpl
       prog%pixels(2,ipix) = prog%begin%frac(2)+(ipix-1)*dpm
    enddo
  end subroutine cubemain_slice_prog_precompute_pixels
  !
  subroutine cubemain_slice_prog_pixels_from_file(prog,filename,error)
    use gkernel_interfaces
    use cubetools_ascii
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_prog_t), intent(inout) :: prog
    character(len=*),    intent(in)    :: filename
    logical,             intent(inout) :: error
    !
    type(spapos_user_t) :: upos
    type(spapos_prog_t) :: ppos
    type(ascii_file_t) :: file
    integer(kind=4) :: ier,iline
    character(len=100) :: line
    character(len=*), parameter :: rname='SLICE>PROG>PIXELS_FROM_FILE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call file%open(filename,'readonly',error)
    if (error) return
    prog%np = file%get_nline()
    allocate(prog%pixels(2,prog%np),stat=ier)
    if (failed_allocate(rname,'Pixel array',ier,error)) return 
    !
    do iline=1,prog%np
       call file%read_next(line,error)
       if (error) return
       call upos%from_line(line,error)
       if (error) return
       call upos%toprog(prog%cube,ppos,error)
       if (error) return
       prog%pixels(:,iline) = ppos%frac(:)
       if (pixel_outofbounds(prog%pixels(:,iline),prog%cube)) then
          call cubemain_message(seve%e,rname,'The following line goes out of bounds:')
          call cubemain_message(seve%r,rname,line)
          error = .true.
       endif
    end do
  end subroutine cubemain_slice_prog_pixels_from_file
  !
  subroutine cubemain_slice_prog_pixels_from_var(prog,varname,unitname,error)
    use gkernel_interfaces
    use cubetools_uservar
    use cubetools_userspace
    use cubetools_header_methods
    use cubetools_unit
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_prog_t), intent(inout) :: prog
    character(len=*),    intent(in)    :: varname
    character(len=*),    intent(in)    :: unitname
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: ier
    integer(kind=pixe_k) :: ip
    integer(kind=ndim_k) :: ndim
    integer(kind=entr_k), allocatable :: dims(:)
    ! VVV For the moments this one is real*4 as to not oblige the user
    ! to create a real*8 on SIC
    real(kind=4), allocatable :: offsets(:,:)
    type(uservar_t) :: var
    character(len=mess_l) :: mess
    type(unit_user_t) :: unit
    integer(kind=4), parameter :: il=1,im=2
    character(len=*), parameter :: rname='SLICE>PROG>PIXELS_FROM_FILE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_userspace_get('real',varname,var,error)
    if (error) return
    call var%get_dims(ndim,dims,error)
    if (error) return
    if (ndim.ne.2) then
       write(mess,'(a,i0,a)') 'Expected a 2D array got a ',ndim,'D array'
       call cubemain_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    if (dims(1).ne.2) then
       write(mess,'(2(a,i0))') 'Expected a 2 x n array, got ',dims(1),'x',dims(2)
       call cubemain_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    prog%np = dims(2)
    allocate(prog%pixels(2,prog%np),offsets(2,prog%np),stat=ier)
    if (failed_allocate(rname,'Pixel array',ier,error)) return 
    call var%get(offsets,error)
    if (error) return
    call cubetools_unit_get(unitname,code_unit_fov,unit,error)
    if (error) return
    !
    do ip=1,prog%np
       call cubetools_header_spatial_offset2pixel(prog%cube%head,offsets(:,ip)*unit%prog_per_user,&
            prog%pixels(:,ip),error)
       if (pixel_outofbounds(prog%pixels(:,ip),prog%cube)) then
          call cubemain_message(seve%e,rname,'The following coordinates go out of bounds:')
          write (mess,'(2(a,1pg14.7),2a)') '(',offsets(il,ip),',',offsets(im,ip),') ',unit%name
          call cubemain_message(seve%r,rname,mess)
          error = .true.
       endif
    enddo
  end subroutine cubemain_slice_prog_pixels_from_var
  !
  function pixel_outofbounds(pixel,cube) result(out)
    !----------------------------------------------------------------------
    ! Tests if a pixel is out of bounds
    !----------------------------------------------------------------------
    real(kind=coor_k), intent(in)   :: pixel(2)
    type(cube_t),      intent(in)   :: cube
    logical                         :: out
    !
    integer(kind=4), parameter :: il=1,im=2
    !
    out = .false.
    out = pixel(il).lt.0.
    out = out.or.pixel(il).gt.cube%head%arr%n%l
    out = out.or.pixel(im).lt.0
    out = out.or.pixel(im).gt.cube%head%arr%n%m
  end function pixel_outofbounds
  !
  subroutine cubemain_slice_prog_header(prog,error)
    use gkernel_types, only: projection_t
    use gkernel_interfaces
    use cubetools_axis_types
    use cubetools_spapro_types
    use cubetools_header_methods
    use cubetools_unit
    use cubedag_allflags
    use cubeadm_clone
    !----------------------------------------------------------------------
    ! Output File is ordered as nl,1,nc as to make possible a simple
    ! logic of access by image
    ! ----------------------------------------------------------------------
    class(slice_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    real(kind=coor_k) :: offset(2)
    type(projection_t) :: gproj
    type(spapro_t) :: spapro
    type(axis_t) :: axis
    type(unit_user_t) :: pixe
    character(len=*), parameter :: rname='SLICE>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(prog%cube,flag_slice,prog%slice,error)
    if (error) return
    call cubetools_header_nullify_axset_m(prog%slice%head,error)
    if (error) return
    !
    if (prog%dopoints) then
       call cubetools_header_get_axis_head_l(prog%slice%head,axis,error)
       if (error) return
       axis%name = 'Point Slice'    
       axis%n = prog%np
       axis%ref = 1d0
       axis%val = 0d0
       axis%inc = 1d0
       axis%kind = code_unit_pixe
       call cubetools_unit_get(strg_star,code_unit_pixe,pixe,error)
       if (error) return
       axis%unit = pixe%name
       call cubetools_header_update_axset_l(axis,prog%slice%head,error)
       if (error) return
    else
       call cubetools_header_get_axis_head_l(prog%slice%head,axis,error)
       if (error) return
       axis%name = 'Slice'    
       axis%n = prog%np
       axis%ref = 1d0
       axis%val = 0d0
       axis%inc = sqrt(prog%dx**2+prog%dy**2)
       call cubetools_header_update_axset_l(axis,prog%slice%head,error)
       if (error) return
       !
       ! Projection
       call cubetools_header_get_spapro(prog%slice%head,spapro,gproj,error)
       if (error) return
       ! *** JP It would be better to use the mid-point instead of the beginning point
       ! *** JP But, in fact, it would require a rethinking of projection effects
       call cubetools_header_spatial_pixel2offset(prog%cube%head,prog%pixels(:,1),offset,error)
       if (error) return
       call rel_to_abs(gproj,offset(1),offset(2),spapro%l0,spapro%m0,1)
       spapro%pa = prog%ang
       call cubetools_header_put_spapro(spapro,prog%slice%head,error)
       if (error) return
    endif
  end subroutine cubemain_slice_prog_header
  !
  subroutine cubemain_slice_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='SLICE>PROG>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP PARALLEL DEFAULT(none) SHARED(prog,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error)  exit
       !$OMP TASK SHARED(prog) FIRSTPRIVATE(iter,error)
       if (.not.error)  &
         call prog%image_loop(iter%first,iter%last,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_slice_prog_data
  !
  subroutine cubemain_slice_prog_image_loop(prog,first,last,error)
    use cubeadm_entryloop
    use cubemain_image_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_prog_t),   intent(inout) :: prog
    integer(kind=entr_k), intent(in)    :: first
    integer(kind=entr_k), intent(in)    :: last
    logical,              intent(inout) :: error
    !
    integer(kind=entr_k) :: ie
    type(image_t) :: inima,ouima
    character(len=*), parameter :: rname='SLICE>PROG>IMAGE>LOOP'
    !
    call inima%init(prog%cube,error)
    if (error) return
    call ouima%reallocate('slice',prog%slice%head%arr%n%l,prog%slice%head%arr%n%m,error)
    if (error) return
    !
    do ie=first,last
      call cubeadm_entryloop_iterate(ie,error)
      if (error)  return
      call prog%image(ie,inima,ouima,error)
      if (error)  return
    enddo ! ie
  end subroutine cubemain_slice_prog_image_loop
  !
  subroutine cubemain_slice_prog_image(prog,ie,inima,ouima,error)
    use cubetools_nan
    use cubemain_image_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_prog_t),   intent(inout) :: prog
    integer(kind=entr_k), intent(in)    :: ie
    type(image_t),        intent(inout) :: inima  ! Working buffer
    type(image_t),        intent(inout) :: ouima  ! Working buffer
    logical,              intent(inout) :: error
    !
    integer(kind=pixe_k) :: ipix,nl,nm,inpix(2)
    real(coor_k) :: delta(2)
    character(len=*), parameter :: rname='SLICE>PROG>IMAGE'
    !
    nl = prog%cube%head%arr%n%l
    nm = prog%cube%head%arr%n%m
    !
    call inima%get(prog%cube,ie,error)
    if (error)  return
    do ipix=1,prog%np
       inpix(:) = int(prog%pixels(:,ipix))
       delta(:) = prog%pixels(:,ipix)-dble(inpix(:))
       if((inpix(1).lt.1).or.(inpix(2).lt.1).or.(inpix(1).ge.nl).or.(inpix(2).ge.nm))then
          ouima%z(ipix,1) = gr4nan
       else
          ouima%z(ipix,1) = delta(1)*delta(2)*inima%z(inpix(1)+1,inpix(2)+1)   &
               +(1.0-delta(1))*delta(2)* inima%z(inpix(1),inpix(2)+1)   &
               +(1.0-delta(1))*(1.0-delta(2))*inima%z(inpix(1),inpix(2))&
               +delta(1)*(1.0-delta(2))*inima%z(inpix(1)+1,inpix(2))
       endif
    enddo ! ipix
    call ouima%put(prog%slice,ie,error)
    if (error)  return
  end subroutine cubemain_slice_prog_image
end module cubemain_slice
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
