!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_extract
  use cubetools_parameters
  use cubetools_structure
  use cube_types
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubemain_messaging
  use cubemain_windowing
  use cubemain_ancillary_refhead_types
  use cubetopology_speline_types
  use cubetopology_sperange_types
  use cubetopology_sparange_types
  use cubetopology_spapos_types
  use cubetopology_spasize_types
  use cubetopology_cuberegion_types
  !
  public :: extract
  private
  !
  type :: extract_comm_t
     type(option_t),     pointer    :: comm
     type(cubeid_arg_t), pointer    :: cube
     type(sperange_opt_t)           :: range
     type(speline_opt_t)            :: freq
     type(spapos_comm_t)            :: center
     type(spasize_opt_t)            :: size
     type(ancillary_refhead_comm_t) :: reference  ! Support for /LIKE
     type(cube_prod_t),  pointer    :: extracted
   contains
     procedure, public  :: register => cubemain_extract_register
     procedure, private :: parse    => cubemain_extract_parse
     procedure, private :: main     => cubemain_extract_main
  end type extract_comm_t
  type(extract_comm_t) :: extract
  !
  type extract_user_t
     type(cubeid_user_t)            :: cubeids
     type(speline_user_t)           :: line       ! Optional new line name and freq
     type(sperange_user_t)          :: range      ! Spectral range to be extracted
     type(spapos_user_t)            :: center     ! [absolute|relative] Center of the region to be extracted
     type(spasize_user_t)           :: size       ! Size of the region to be extracted
     type(ancillary_refhead_user_t) :: reference
   contains
     procedure, private :: toprog => cubemain_extract_user_toprog
  end type extract_user_t
  !
  type extract_prog_t
     type(cube_t), pointer          :: cube       ! Input cube
     type(cube_t), pointer          :: extracted  ! Extracted cube
     logical                        :: doline
     type(speline_prog_t)           :: line
     type(sperange_user_t)          :: sperange
     integer(kind=ndim_k)           :: ix,iy,ic
     integer(kind=data_k)           :: range(3,2) ! Extracted ranges
     type(cuberegion_prog_t)        :: region     !
     type(ancillary_refhead_prog_t) :: reference
   contains
     procedure, private :: header          => cubemain_extract_prog_header
     procedure, private :: header_spectral => cubemain_extract_prog_header_spectral
     procedure, private :: header_spatial  => cubemain_extract_prog_header_spatial
     procedure, private :: create_region   => cubemain_extract_create_region
     procedure, private :: data            => cubemain_extract_prog_data     
     procedure, private :: loop            => cubemain_extract_prog_loop
     procedure, private :: act             => cubemain_extract_prog_act
  end type extract_prog_t
  !
contains
  !
  subroutine cubemain_extract_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(extract_user_t) :: user
    character(len=*), parameter :: rname='EXTRACT>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    call extract%parse(line,user,error)
    if (error) return
    call extract%main(user,error)
    if (error) return
  end subroutine cubemain_extract_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_extract_register(extract,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(extract_comm_t), intent(inout) :: extract
    logical,               intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(cube_prod_t) :: oucube
    !
    character(len=*), parameter :: rname='EXTRACT>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'EXTRACT','[cube]',&
         'Extract a subcube',&
         'Extract a subcube from the input cube using spectral and spatial selectors.'//strg_bl//&
         'Behavior:'//strg_cr//&
         '- /FREQUENCY changes velocity-axis interpretation by setting&
         & the source systemic velocity at the user-provided line rest&
         & frequency.'//strg_cr//&
         '- /LIKE copies extraction geometry from a reference cube and is exclusive with /RANGE, /CENTER, and /SIZE.'//strg_cr//&
         '- After option checks, EXTRACT reads only the minimum input&
         & cube subset needed for the requested region and range. This&
         & is especially important for huge input cubes.'//strg_cr//&
         '- At least one option must be provided.'//strg_cr//&
         '- /CENTER requires /SIZE in the same command line.'//strg_bl//&
         'Examples:'//strg_cr//&
         'CUBE> EXTRACT cubeA /RANGE -10 10 km/s'//strg_cr//&
         'CUBE> EXTRACT cubeA /CENTER 0 0 relative /SIZE 60 60 /RANGE&
         & -5 5 km/s'//strg_cr//&
         'CUBE> EXTRACT cubeA /LIKE refcube',&
         cubemain_extract_command,&
         extract%comm,error)
    if (error) return
    call cubearg%register(&
         'CUBE',&
         'Signal cube',&
         'If omitted, use the last matching cube (cube flag) in&
         & the default index (DAG by default; see SET\INDEX).',&
         code_arg_optional,&
         [flag_cube],&
         code_read,&
         code_access_subset,&
         extract%cube,&
         error)
    if (error) return
    !
    call extract%range%register('RANGE',&
         'Spectral range of the extracted region',&
         error)
    if (error) return
    !
    call extract%freq%register(&
         'Line name & rest frequency of the extracted region',&
         error)
    if (error) return
    !
    call extract%center%register('CENTER',&
         'Spatial center of the extracted region',&
         error)
    if (error) return
    !
    call extract%size%register(&
         'Spatial size of the extracted region',&
         error)
    if (error) return
    !
    call extract%reference%register('EXTRACT',error)
    if (error) return
    !
    ! Product
    call oucube%register(&
         'EXTRACTED',&
         'Extracted cube',&
         strg_emp,&
         [flag_extract,flag_cube],&
         extract%extracted,&
         error)
    if (error) return
  end subroutine cubemain_extract_register
  !
  subroutine cubemain_extract_parse(extract,line,user,error)
    !----------------------------------------------------------------------
    ! EXTRACT [cubeid]
    ! /RANGE first last [unit]
    ! /FREQUENCY line frequency [unit]
    ! /CENTER xpos ypos type [unit]
    ! /SIZE sx [sy [unit]]
    ! /LIKE [refcube]
    !----------------------------------------------------------------------
    class(extract_comm_t), intent(in)    :: extract
    character(len=*),      intent(in)    :: line
    type(extract_user_t),  intent(out)   :: user
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='EXTRACT>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,extract%comm,user%cubeids,error)
    if (error) return
    call extract%range%parse(line,user%range,error)
    if (error) return
    call extract%freq%parse(line,user%line,error)
    if (error) return
    call extract%center%parse(line,user%center,error)
    if (error) return
    call extract%size%parse(line,user%size,error)
    if (error) return
    call extract%reference%parse(line,user%reference,error)
    if (error) return
    !
    ! Sanity
    if (cubetools_nopt().eq.0) then
       call cubemain_message(seve%e,rname,'No options given, nothing to do')
       error = .true.
       return
    endif
    if (user%center%present.and..not.user%size%do) then
       call cubemain_message(seve%e,rname,'A size must be specified when giving a new center')
       error = .true.
       return
    endif
    if (user%reference%present .and. &
        (user%center%present .or. user%size%do .or. user%range%do)) then
       call cubemain_message(seve%e,rname,'/LIKE is exclusive with /RANGE /CENTER /SIZE')
       error = .true.
       return
    endif
  end subroutine cubemain_extract_parse
  !
  subroutine cubemain_extract_main(extract,user,error)
    use cubeadm_timing
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(extract_comm_t), intent(in)    :: extract
    type(extract_user_t),  intent(in)    :: user
    logical,               intent(inout) :: error
    !
    type(extract_prog_t) :: prog
    character(len=*), parameter :: rname='EXTRACT>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(extract,prog,error)
    if (error) return
    call prog%header(extract,error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubemain_extract_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_extract_user_toprog(user,comm,prog,error)
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(extract_user_t), intent(in)    :: user
    type(extract_comm_t),  intent(in)    :: comm
    type(extract_prog_t),  intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    integer(kind=chan_k) :: stride
    real(kind=coor_k) :: offset(2)
    type(sparange_prog_t) :: lrange,mrange
    type(spapos_prog_t) :: center
    integer(kind=ndim_k), parameter :: ix=1,iy=2
    character(len=*), parameter :: rname='EXTRACT>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_get_header(extract%cube,user%cubeids,prog%cube,error)
    if (error) return
    !
    select case (prog%cube%order())
    case (code_cube_imaset)
       prog%ix = 1
       prog%iy = 2
       prog%ic = 3
    case (code_cube_speset)
       prog%ix = 2
       prog%iy = 3
       prog%ic = 1
    case default
       call cubemain_message(seve%e,rname,'Order not supported')
       error = .true.
       return
    end select
    !
    prog%doline = user%line%do
    if (prog%doline) then
       call user%line%toprog(prog%cube,prog%line,error)
       if (error) return
    endif
    !
    if (user%reference%present) then
      call cubemain_extract_user_toprog_reference(user,comm,prog, &
           prog%sperange,lrange,mrange,error)
      if (error)  return
    else
      ! User range is just copied because range resolution has to be done
      ! after frequency modification
      prog%sperange = user%range
      !
      ! Spatial center
      call user%center%toprog(prog%cube,center,error)
      if (error) return
      call center%offset(offset,error)
      if (error) return
      !
      ! Spatial ranges
      call lrange%fromuser(code_sparange_truncated,prog%cube%head%set%il,prog%cube,offset(ix),&
           user%size%x,user%size%unit,prog%cube%head%spa%l%inc,&
           prog%cube%head%spa%l%kind,error)
      if (error) return
      call mrange%fromuser(code_sparange_truncated,prog%cube%head%set%im,prog%cube,offset(iy),&
           user%size%y,user%size%unit,prog%cube%head%spa%m%inc,&
           prog%cube%head%spa%m%kind,error)
      if (error) return
    endif
    !
    call lrange%to_pixe_k(prog%range(prog%ix,1),prog%range(prog%ix,2),stride,error)
    if (error) return
    call mrange%to_pixe_k(prog%range(prog%iy,1),prog%range(prog%iy,2),stride,error)
    if (error) return
  end subroutine cubemain_extract_user_toprog
  !
  subroutine cubemain_extract_user_toprog_reference(user,comm,prog, &
    crange,lrange,mrange,error)
    use gkernel_interfaces
    use gkernel_types
    use cubetools_spapro_types
    !-------------------------------------------------------------------
    ! From the reference (/LIKE) cube provided by the user, fill the
    ! equivalent user* types
    !-------------------------------------------------------------------
    class(extract_user_t), intent(in)    :: user
    type(extract_comm_t),  intent(in)    :: comm
    type(extract_prog_t),  intent(inout) :: prog
    type(sperange_user_t), intent(out)   :: crange
    type(sparange_prog_t), intent(out)   :: lrange,mrange
    logical,               intent(inout) :: error
    !
    integer(kind=ndim_k) :: ref_ic,ref_il,ref_im
    real(kind=coor_k) :: lmin,lmax,loff(4),labs(4)
    real(kind=coor_k) :: mmin,mmax,moff(4),mabs(4)
    type(projection_t) :: gproj
    character(len=*), parameter :: rname='EXTRACT>USER>TOPROG>REFERENCE'
    !
    ! Fetch the reference header
    call user%reference%toprog(comm%reference,prog%reference,error)
    if (error) return
    !
    ! Spectral range
    ref_ic = prog%reference%cube%head%set%ic
    write(crange%val(1),'(1pg25.16)') prog%reference%cube%head%set%axis(ref_ic)%get_min()
    write(crange%val(2),'(1pg25.16)') prog%reference%cube%head%set%axis(ref_ic)%get_max()
    crange%unit =                     prog%reference%cube%head%set%axis(ref_ic)%unit
    !
    ! Spatial range: define 4 absolute positions at the middle of each
    ! side (not the corners to limit projection effects):
    !           2
    !         1   3
    !           4
    !
    ! Reference ranges (relative coordinates)
    ! ZZZ Should ensure in radians!
    ! ZZZ We ask for min/max but we should actually pick left/right, and respect
    !     the order in lrange%fromrange()
    ref_il = prog%reference%cube%head%set%il
    lmin = prog%reference%cube%head%set%axis(ref_il)%get_min()
    lmax = prog%reference%cube%head%set%axis(ref_il)%get_max()
    ref_im = prog%reference%cube%head%set%im
    mmin = prog%reference%cube%head%set%axis(ref_im)%get_min()
    mmax = prog%reference%cube%head%set%axis(ref_im)%get_max()
    !
    ! The 4 reference points in relative coordinates:
    loff(1) = lmin
    loff(2) = (lmin+lmax)/2.d0
    loff(3) = lmax
    loff(4) = (lmin+lmax)/2.d0
    moff(1) = (mmin+mmax)/2.d0
    moff(2) = mmax
    moff(3) = (mmin+mmax)/2.d0
    moff(4) = mmin
    !
    ! Convert from relative to absolute with the reference cube:
    call prog%reference%cube%head%spa%pro%gwcs(gproj,error)
    if (error) return
    call rel_to_abs(gproj,loff,moff,labs,mabs,4)
    !
    ! Convert the spherical coordinates from ref system to output system:
    ! ZZZ Don't we have a utility for this???
    if (prog%reference%cube%head%spa%fra%code .ne. &
                  prog%cube%head%spa%fra%code) then
      call cubemain_message(seve%e,rname,  &
        'Input and output cubes do not have the same coordinate system (not implemented)')
      error = .true.
      return
    endif
    !
    ! Convert back from absolute to relative in the extracted cube system:
    call prog%cube%head%spa%pro%gwcs(gproj,error)
    if (error) return
    call abs_to_rel(gproj,labs,mabs,loff,moff,4)
    !
    ! Fill the range types
    call lrange%fromrela(prog%cube%head%set%il,prog%cube,loff(1),loff(3),error)
    if (error)  return
    call mrange%fromrela(prog%cube%head%set%im,prog%cube,moff(4),moff(2),error)
    if (error)  return
  end subroutine cubemain_extract_user_toprog_reference
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_extract_prog_header(prog,comm,error)
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(extract_prog_t), intent(inout) :: prog
    type(extract_comm_t),  intent(in)    :: comm
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='EXTRACT>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(comm%extracted,prog%cube,prog%extracted,error)
    if (error) return
    call prog%header_spectral(error)
    if (error) return
    call prog%header_spatial(error)
    if (error) return
    call prog%create_region(error)
    if (error) return
  end subroutine cubemain_extract_prog_header
  !
  subroutine cubemain_extract_create_region(prog,error)
    !-----------------------------------------------------------------
    ! Ad-hoc subroutine which converts the 3 ranges to a region type,
    ! for later use by cubeadm_datainit_all.
    !
    ! We allow here the 3rd range to overlap the cube boundaries (no
    ! truncation) because the iterator knows how to deal with this
    ! case.
    !
    ! On the other hand, the 2 first dimensions are kept full (no
    ! subset, no surset), because the subcube%get() API is not able
    ! to get a subcube overlapping the boundaries. This is treated
    ! locally with special care in cubemain_extract_prog_act.
    !-----------------------------------------------------------------
    class(extract_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    ! Default full dimensions:
    ! - 'code_indx_auto' stand for the dimensions of the cube associated
    !   cube to the entry. Remember that in the current command,
    !   dimensions of the input and output cubes might differ in all
    !   directions.
    ! - explicit values would be used explicitly. This is not what we
    !   want as our input subcubes and output subcubes might differ
    !   in size.
    prog%region%ix%first = code_indx_auto
    prog%region%ix%last = code_indx_auto
    prog%region%iy%first = code_indx_auto
    prog%region%iy%last = code_indx_auto
    prog%region%iz%first = code_indx_auto
    prog%region%iz%last = code_indx_auto
    !
    ! Then subset/surset for the last dimension
    if (prog%ix.eq.3) then
      prog%region%ix%first = prog%range(3,1)
      prog%region%ix%last  = prog%range(3,2)
    elseif (prog%iy.eq.3) then
      prog%region%iy%first = prog%range(3,1)
      prog%region%iy%last  = prog%range(3,2)
    elseif (prog%ic.eq.3) then
      prog%region%iz%first = prog%range(3,1)
      prog%region%iz%last  = prog%range(3,2)
    endif
  end subroutine cubemain_extract_create_region
  !
  subroutine cubemain_extract_prog_header_spectral(prog,error)
    use cubetools_unit
    use cubetools_axis_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    ! *** JP *** Think twice before modifying this one!
    !----------------------------------------------------------------------
    class(extract_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(axis_t) :: axis
    integer(kind=chan_k) :: stride
    type(sperange_prog_t) :: sperange
    character(len=*), parameter :: rname='EXTRACT>PROG>HEADER>SPECTRAL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Everything below is needed!
    if (prog%doline) then
       call cubetools_header_modify_rest_frequency(prog%line%freq,prog%extracted%head,error)
       if (error) return
       call cubetools_header_put_line(prog%line%name,prog%extracted%head,error)
       if (error) return
       call cubetools_header_get_axis_head_f(prog%extracted%head,axis,error)
       if (error) return
       call cubetools_header_update_frequency_from_axis(axis,prog%extracted%head,error)
       if (error) return
    endif
    !
    ! This part of the code has to be executed after the frequency
    ! modification otherwise the range of velocities is wrong!
    call prog%sperange%toprog(prog%extracted,code_sperange_truncated,sperange,error)
    if (error) return
    call sperange%to_chan_k(prog%range(prog%ic,1),prog%range(prog%ic,2),stride,error)
    if (error) return
    !
    call cubetools_header_get_axis_head_c(prog%extracted%head,axis,error)
    if (error) return
    axis%n = prog%range(prog%ic,2)-prog%range(prog%ic,1)+1
    axis%ref = axis%ref-prog%range(prog%ic,1)+1
    !
    ! This snippet of code was copied from: lib/edit/type-cube-buffer.f90:cubeedit_cube_buffer_resize
    ! This points to the necessity of factorizing this piece of code in lib/tools/header-methods.f90x
    if (axis%kind.eq.code_unit_freq) then
       call cubetools_header_update_frequency_from_axis(axis,prog%extracted%head,error)
       if (error) return
    else if (axis%kind.eq.code_unit_velo) then
       call cubetools_header_update_velocity_from_axis(axis,prog%extracted%head,error)
       if (error) return
    else
       call cubetools_header_update_axset_c(axis,prog%extracted%head,error)
       if (error) return
       call cubemain_message(seve%w,rname,'Unknown kind of Spectral axis')
    endif
  end subroutine cubemain_extract_prog_header_spectral
  !
  subroutine cubemain_extract_prog_header_spatial(prog,error)
    use cubetools_axis_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(extract_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(axis_t) :: laxis, maxis
    character(len=*), parameter :: rname='EXTRACT>PROG>HEADER>SPATIAL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_header_get_axis_head_l(prog%extracted%head,laxis,error)
    if (error) return
    laxis%n = prog%range(prog%ix,2)-prog%range(prog%ix,1)+1
    laxis%ref = laxis%ref-1d0*prog%range(prog%ix,1)+1d0
    call cubetools_header_update_axset_l(laxis,prog%extracted%head,error)
    if (error) return
    !
    call cubetools_header_get_axis_head_m(prog%extracted%head,maxis,error)
    if (error) return
    maxis%n = prog%range(prog%iy,2)-prog%range(prog%iy,1)+1
    maxis%ref = maxis%ref-1d0*prog%range(prog%iy,1)+1d0
    call cubetools_header_update_axset_m(maxis,prog%extracted%head,error)
    if (error) return
  end subroutine cubemain_extract_prog_header_spatial
  !
  subroutine cubemain_extract_prog_data(prog,error)
    use cubeadm_opened
    use cubetools_header_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(extract_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: itertask
    character(len=*), parameter :: rname='EXTRACT>PROG>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(itertask,prog%region,error)
    if (error) return
    !
    !$OMP PARALLEL DEFAULT(none) SHARED(prog,error) FIRSTPRIVATE(itertask)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(itertask,error))
       if (error) exit
       !$OMP TASK SHARED(prog,error) FIRSTPRIVATE(itertask)
       if (.not.error) then
          call prog%loop(itertask,error)
       endif
       !$OMP END TASK
    enddo ! itertask
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_extract_prog_data
  !
  subroutine cubemain_extract_prog_loop(prog,itertask,error)
    use cubeadm_taskloop
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(extract_prog_t),    intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: itertask
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='EXTRACT>PROG>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    do while (itertask%iterate_entry(error))
      call prog%act(itertask,error)
      if (error) return
    enddo  ! ientry
  end subroutine cubemain_extract_prog_loop
  !
  subroutine cubemain_extract_prog_act(prog,itertask,error)
    use cubetools_nan
    use cubeadm_taskloop
    use cubeadm_subcube_types
    !-------------------------------------------------------------------
    ! Extract from 1 subcube
    !-------------------------------------------------------------------
    class(extract_prog_t),    intent(inout) :: prog
    type(cubeadm_iterator_t), intent(in)    :: itertask
    logical,                  intent(inout) :: error
    !
    type(subcube_t) :: insub,ousub
    integer(kind=indx_k) :: ix,jx,ixmin,ixmax,ixoff
    integer(kind=indx_k) :: iy,jy,iymin,iymax,iyoff
    integer(kind=indx_k) :: iz,jz,izmin,izmax,izoff
    logical :: overlap
    character(len=*), parameter :: rname='EXTRACT>PROG>ACT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Subcubes are initialized here as their size (3rd dim) may change from
    ! from one subcube to another.
    call insub%associate('insub',prog%cube,itertask,error)
    if (error) return
    call ousub%allocate('ousub',prog%extracted,itertask,error)
    if (error) return
    !
    call insub%get(error)
    if (error) return
    !
    overlap = .false.
    !
    ! 1st dimension
    ixoff = prog%range(1,1)-1
    ixmin = prog%range(1,1)
    if (ixmin.lt.1) then
      overlap = .true.
      ixmin = 1
    endif
    ixmax = prog%range(1,2)
    if (ixmax.gt.insub%nx) then
      overlap = .true.
      ixmax = insub%nx
    endif
    !
    ! 2nd dimension
    iyoff = prog%range(2,1)-1
    iymin = prog%range(2,1)
    if (iymin.lt.1) then
      overlap = .true.
      iymin = 1
    endif
    iymax = prog%range(2,2)
    if (iymax.gt.insub%ny) then
      overlap = .true.
      iymax = insub%ny
    endif
    !
    ! 3rd dimension: subcubes
    izoff = insub%v3shift
    izmin = 1
    izmax = insub%nz
    if (izmax.gt.insub%nvalid3) then
      overlap = .true.
      izmax = insub%nvalid3
    endif
    !
    ! In case of surset extraction, initialize the new bits to NaN.
    ! For simplicity, initialize everything. NaN will be overwritten by
    ! valid values afterwards.
    if (overlap) then
      call ousub%set(gr4nan,error)
      if (error) return
    else
       continue ! No overlap cube boundaries, no init
    endif
    !
    do iz=izmin,izmax
      jz = iz-izoff
      do iy=iymin,iymax
        jy = iy-iyoff
        do ix=ixmin,ixmax
          jx = ix-ixoff
          ousub%val(jx,jy,jz) = insub%val(ix,iy,iz)
        enddo ! ix
      enddo ! iy
    enddo ! iz
    !
    call ousub%put(error)
    if (error) return
  end subroutine cubemain_extract_prog_act
end module cubemain_extract
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
