!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SLICE is not a standard case: while it iterates the input cube with
! images, it creates an output cube (which has only 1 plane) with 1 spatial
! axis and 1 spectral axis (no 2nd spatial axis). This has consequences:
!  - header: the output header has IX=spatial axis and IY=spectral axis.
!    This way the io engines and subsequent commands like LOAD know how to
!    deal with this cube.
!  - data: the output "cube" (single plane) is fully filled after all the
!    input planes are iterated. This means fullset access: 1 allocation for
!    the whole output plane, fill it during the input plane iterations
!    (parallelization is allowed), write it once at the end.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_slice
  use cubetools_parameters
  use cube_types
  use cubetools_structure
  use cubetools_unit_arg
  use cubetools_shape_types
  use cubetopology_spapos_types
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubemain_messaging
  !
  public :: slice
  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_comm_t) :: begin
     type(spapos_comm_t) :: end
     type(option_t),     pointer :: posfile
     type(option_t),     pointer :: variable
     type(unit_arg_t),   pointer :: unit
     type(cubeid_arg_t), pointer :: cube
     type(cube_prod_t),  pointer :: slice
   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
  !
  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
     type(shape_t)         :: ncube                ! [---] Shape of input cube                  
     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 :: loop              => cubemain_slice_prog_loop
     procedure, private :: act               => cubemain_slice_prog_act
  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(comm,error)
    use cubetools_unit
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(inout) :: comm
    logical,             intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(cube_prod_t) :: oucube
    type(unit_arg_t) :: unitarg
    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,&
         comm%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Signal cube',  &
         strg_id,&
         code_arg_optional,  &
         [flag_cube], &
         code_read, &
         code_access_imaset, &
         comm%cube, &
         error)
    if (error) return
    !
    call comm%begin%register('BEGIN',&
         'Beginning point of the slice',&
         error)
    if (error) return
    call comm%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.',&
         comm%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',&
         comm%variable,error)
    if (error) return
    call stdarg%register(&
         'var',&
         'SIC variable containing positions',&
          strg_id,&
          code_arg_mandatory, error)
    if (error) return
    call unitarg%register(&
         'unit',&
         'Position coordinate unit',&
         strg_id,&
         code_arg_optional,&
         code_unit_fov,&
         comm%unit,&
         error)
    if (error) return
    !
    ! Product
    call oucube%register(&
         'SLICE',&
         'The 2D slice',&
         strg_id,&
         [flag_slice],&
         comm%slice,&
         error,&
         access=code_access_fullset)
    if (error) return
  end subroutine cubemain_slice_register
  !
  subroutine cubemain_slice_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! SLICE cubname
    ! /BEGIN cx cy
    ! /END cx cy
    ! /POSFILE file
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(in)    :: comm
    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,comm%comm,user%cubeids,error)
    if (error) return
    call comm%begin%parse(line,user%begin,error)
    if (error) return
    call comm%end%parse(line,user%end,error)
    if (error) return
    call comm%parse_posfile(line,user,error)
    if (error) return
    call comm%parse_var(line,user,error)
    if (error) return
    !
    if (user%dofile) then
       if (user%begin%present.or.user%end%present.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%present.or.user%end%present.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%present) then
          call cubemain_message(seve%e,rname,'Option /BEGIN is mandatory')
          error = .true.
       endif
       if (.not.user%end%present) 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(comm,line,user,error)
    !----------------------------------------------------------------------
    ! /POSFILE file
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(in)    :: comm
    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 comm%posfile%present(line,user%dofile,error)
    if (error) return
    if (user%dofile) then
       call cubetools_getarg(line,comm%posfile,1,user%posfile,mandatory,error)
       if (error) return
    endif
  end subroutine cubemain_slice_parse_posfile
  !
  subroutine cubemain_slice_parse_variable(comm,line,user,error)
    !----------------------------------------------------------------------
    ! /VARIABLE var [unit]
    !----------------------------------------------------------------------
    class(slice_comm_t), intent(in)    :: comm
    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 comm%variable%present(line,user%dovar,error)
    if (error) return
    if (user%dovar) then
       call cubetools_getarg(line,comm%variable,1,user%varname,mandatory,error)
       if (error) return
       user%unit = strg_star
       call cubetools_getarg(line,comm%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(slice,prog,error)
    if (error) return
    call prog%header(slice,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,comm,prog,error)
    use cubetools_header_methods
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(slice_user_t), intent(in)    :: user
    type(slice_comm_t),  intent(in)    :: comm
    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_get_header(comm%cube,user%cubeids,prog%cube,error)
    if (error) return
    !
    prog%dopoints = user%dofile.or.user%dovar
    call cubetools_header_get_array_shape(prog%cube%head,prog%ncube,error)
    if (error) return
    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%ncube)) then
          call cubemain_message(seve%e,rname,'The following line goes out of bounds:')
          call cubemain_message(seve%r,rname,line)
          error = .true.
       endif
    enddo
  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 :: ix=1,iy=2
    character(len=*), parameter :: rname='SLICE>PROG>PIXELS_FROM_FILE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_userspace_get(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 unit%get_from_name_for_code(unitname,code_unit_fov,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%ncube)) then
          call cubemain_message(seve%e,rname,'The following coordinates go out of bounds:')
          write (mess,'(2(a,1pg14.7),2a)') '(',offsets(ix,ip),',',offsets(iy,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,n) result(out)
    !----------------------------------------------------------------------
    ! Tests if a pixel is out of bounds
    !----------------------------------------------------------------------
    real(kind=coor_k), intent(in)   :: pixel(2)
    type(shape_t),     intent(in)   :: n
    logical                         :: out
    !
    integer(kind=4), parameter :: ix=1,iy=2
    !
    out = .false.
    out = pixel(ix).lt.0. ! *** JP: Bizarre. I would have put 1.0
    out = out.or.pixel(ix).gt.n%l
    out = out.or.pixel(iy).lt.0 ! *** JP: Bizarre. I would have put 1.0
    out = out.or.pixel(iy).gt.n%m
  end function pixel_outofbounds
  !
  subroutine cubemain_slice_prog_header(prog,comm,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 cubeadm_clone
    !----------------------------------------------------------------------
    ! Output File is ordered as nx,nc
    !----------------------------------------------------------------------
    class(slice_prog_t), intent(inout) :: prog
    type(slice_comm_t),  intent(in)    :: comm
    logical,             intent(inout) :: error
    !
    type(axis_t) :: axis
    type(unit_user_t) :: pixeunit
    character(len=*), parameter :: rname='SLICE>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(comm%slice,prog%cube,prog%slice,error)
    if (error) return
    call cubetools_header_get_axis_head_c(prog%slice%head,axis,error)
    if (error) return
    call cubetools_header_update_axset_m(axis,prog%slice%head,error)
    if (error) return
    call cubetools_header_nullify_axset_c(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 = 'SLICE'    
       axis%n = prog%np
       axis%ref = 1d0
       axis%val = 0d0
       axis%inc = 1d0
       axis%kind = code_unit_pixe
       call pixeunit%get_from_code(code_unit_pixe,error)
       if (error) return
       axis%unit = pixeunit%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 = abs(prog%dx)
       call cubetools_header_update_axset_l(axis,prog%slice%head,error)
       if (error) return
       !
       ! Projection has no more obvious meaning => Nullify it
       call cubetools_header_nullify_spapro(prog%slice%head,error)
       !***JP: What about the spatial frame?
    endif
  end subroutine cubemain_slice_prog_header
  !
  subroutine cubemain_slice_prog_data(prog,error)
    use cubeadm_opened
    use cubeadm_fullcube_types
    !----------------------------------------------------------------------
    ! Non-standard case!
    !----------------------------------------------------------------------
    class(slice_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    type(fullcube_t) :: slice
    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
    call slice%allocate('slice',prog%slice,error)
    if (error) return
    !
    !$OMP PARALLEL DEFAULT(none) SHARED(prog,slice,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error) exit
       !$OMP TASK SHARED(prog,slice,error) FIRSTPRIVATE(iter)
       if (.not.error) &
         call prog%loop(iter,slice,error)
       !$OMP END TASK
    enddo ! iter
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_slice_prog_data
  !
  subroutine cubemain_slice_prog_loop(prog,iter,slice,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    use cubeadm_fullcube_types
    !----------------------------------------------------------------------
    ! Non-standard case!
    !----------------------------------------------------------------------
    class(slice_prog_t),      intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    type(fullcube_t),         intent(inout) :: slice
    logical,                  intent(inout) :: error
    !
    type(image_t) :: image
    character(len=*), parameter :: rname='SLICE>PROG>LOOP'
    !
    call image%associate('image',prog%cube,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
       call prog%act(iter%ie,image,slice,error)
       if (error) return
    enddo ! ie
    call slice%put(error)
    if (error) return
  end subroutine cubemain_slice_prog_loop
  !
  subroutine cubemain_slice_prog_act(prog,ie,image,slice,error)
    use cubetools_nan
    use cubeadm_image_types
    use cubeadm_fullcube_types
    !----------------------------------------------------------------------
    ! Non-standard case!
    !----------------------------------------------------------------------
    class(slice_prog_t),  intent(inout) :: prog
    integer(kind=entr_k), intent(in)    :: ie
    type(image_t),        intent(inout) :: image
    type(fullcube_t),     intent(inout) :: slice
    logical,              intent(inout) :: error
    !
    integer(kind=pixe_k) :: ix,inpix(2)
    real(coor_k) :: delta(2)
    character(len=*), parameter :: rname='SLICE>PROG>ACT'
    !
    call image%get(ie,error)
    if (error) return
    do ix=1,slice%nx
       inpix(:) = int(prog%pixels(:,ix))
       delta(:) = prog%pixels(:,ix)-dble(inpix(:))
       if ((inpix(1).lt.1).or.(inpix(2).lt.1).or.(inpix(1).ge.image%nx).or.(inpix(2).ge.image%ny)) then
          slice%val(ix,ie,1) = gr4nan
       else
          slice%val(ix,ie,1) = delta(1)*delta(2)*image%val(inpix(1)+1,inpix(2)+1)   &
               +(1.0-delta(1))*delta(2)* image%val(inpix(1),inpix(2)+1)   &
               +(1.0-delta(1))*(1.0-delta(2))*image%val(inpix(1),inpix(2))&
               +delta(1)*(1.0-delta(2))*image%val(inpix(1)+1,inpix(2))
       endif
    enddo ! ix
  end subroutine cubemain_slice_prog_act
end module cubemain_slice
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
