!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_stack_spectral
  use cubemain_messaging
  use cube_types
  use cubeadm_cubeprod_types
  use cubemain_windowing
  use cubemain_spaelli_types
  use cubetopology_spapos_types
  use cubetools_nan
  !
  public :: cubemain_stack_spectral_domean
  public :: cubemain_stack_spectral_noaperture,cubemain_stack_spectral_aperture
  private
  !
  integer(kind=entr_k), parameter :: one = 1
  !
  type stack_spectral_prog_t
     type(window_array_t), pointer :: wind             ! Window to be spectrally stacked
     type(spapos_prog_t),  pointer :: center           ! Aperture center
     type(ellipse_prog_t), pointer :: aperture         ! Aperture
     type(cube_t), pointer         :: cube             ! Input cube
     type(cube_prod_t)             :: stackprod        ! Output (stacked) spectrum description
     type(cube_t), pointer         :: stacked          ! Output (stacked) spectrum
     type(cube_t), pointer         :: mask             ! Mask
     type(cube_t), pointer         :: noise            ! Noise reference
     real(kind=sign_k)             :: factor           ! brightness conversion factor
     logical                       :: mask2d = .false. ! Is the mask 2d?
     logical                       :: domean = .false. ! Output is a mean spectrum
     logical                       :: domask           ! Use a mask
     logical                       :: donoise          ! Use weighting by noise
     logical                       :: contaminate      ! NaNs contaminate spectrum
     logical, allocatable          :: include(:)       ! Channel is going to be included?
     !
     ! Deferred procedures
     procedure(stack_interface_header), pointer :: header => null()
     procedure(stack_interface_loop),   pointer :: loop   => null()
   contains
     generic   :: init            => init_aperture,init_noaperture
     procedure :: init_aperture   => cubemain_stack_spectral_aperture_init
     procedure :: init_noaperture => cubemain_stack_spectral_noaperture_init
     procedure :: allocate        => cubemain_stack_spectral_allocate
     procedure :: header_setscale => cubemain_stack_spectral_header_set_scale
     !
     procedure :: data            => cubemain_stack_spectral_data
     procedure :: get             => cubemain_stack_spectral_get_weight_image
     procedure :: act_nomask      => cubemain_stack_spectral_act_nomask
     procedure :: act_mask        => cubemain_stack_spectral_act_mask
  end type stack_spectral_prog_t
  !
contains
  !
  !----------Interfaces--------------------------------------------------
  !
  subroutine stack_interface_header(prog,error)
    !----------------------------------------------------------------------
    ! Interface for deffered procedures
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    logical,                      intent(inout) :: error
  end subroutine stack_interface_header
  !
  subroutine stack_interface_loop(prog,iter,error)
    use cubeadm_taskloop
    !----------------------------------------------------------------------
    ! Interface for deffered procedures
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    type(cubeadm_iterator_t),     intent(inout) :: iter
    logical,                      intent(inout) :: error
  end subroutine stack_interface_loop
  !
  !----------Common-utility----------------------------------------------
  !
  subroutine cubemain_stack_spectral_domean(cube,domean,error)
    use cubetools_header_methods
    use cubetools_brightness
    !----------------------------------------------------------------------
    ! If User has not chosen a mean or a sum decide based on cube unit
    !----------------------------------------------------------------------
    type(cube_t), intent(in)    :: cube
    logical,      intent(out)   :: domean
    logical,      intent(inout) :: error
    !
    logical :: valid
    character(len=unit_l) :: unitin
    integer(kind=code_k) :: codein
    character(len=*), parameter :: rname='STACK>SPECTRAL>DOMEAN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_header_get_array_unit(cube%head,unitin,error)
    if (error) return
    call cubetools_brightness_valid_brightness_unit(unitin,codein,valid,error)
    if (error) return
    if (valid) then
       select case(codein)
       case (code_unit_jyperbeam,code_unit_jyperpixel,code_unit_mjypersr)
          domean = .false.
       case (code_unit_tmb)
          domean = .true.
       case (code_unit_tas)
          call cubemain_message(seve%e,rname,'Convert it with CUBE\CONVERT first')
          error = .true.
          return
       case default
          call cubemain_message(seve%e,rname,'Unknown brightness unit '//trim(unitin))
          error = .true.
          return
       end select
    else
       call cubemain_message(seve%w,rname,'Default to averaging for unit '//trim(unitin))
       domean = .true.
    endif
  end subroutine cubemain_stack_spectral_domean
  !
  !----------Entry-points------------------------------------------------
  !
  subroutine cubemain_stack_spectral_noaperture(domean,window,cube,domask,&
       mask,donoise,noise,stackprod,stacked,error)
    !----------------------------------------------------------------------
    ! Does a stack without aperture
    !----------------------------------------------------------------------
    logical,               intent(in)    :: domean
    type(window_array_t),  intent(in)    :: window
    type(cube_t), pointer, intent(inout) :: cube
    logical,               intent(in)    :: domask
    type(cube_t), pointer, intent(inout) :: mask
    logical,               intent(in)    :: donoise
    type(cube_t), pointer, intent(inout) :: noise
    type(cube_prod_t),     intent(in)    :: stackprod
    type(cube_t), pointer, intent(inout) :: stacked
    logical,               intent(inout) :: error
    !
    type(stack_spectral_prog_t) :: prog
    character(len=*), parameter :: rname='STACK>SPECTRAL>NOAPERTURE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call prog%init(domean,window,cube,domask,mask,donoise,noise,stackprod,stacked,error)
    if (error) return
    call prog%header(error)
    if (error) return
    call prog%data(error)
    if (error) return
  end subroutine cubemain_stack_spectral_noaperture
  !
  subroutine cubemain_stack_spectral_aperture(domean,window,cube,center,  &
    aperture,stackprod,stacked,error)
    !----------------------------------------------------------------------
    ! Does a stack without aperture
    !----------------------------------------------------------------------
    logical,                      intent(in)    :: domean
    type(window_array_t),         intent(in)    :: window
    type(cube_t), pointer,        intent(inout) :: cube
    type(spapos_prog_t), target,  intent(in)    :: center            
    type(ellipse_prog_t), target, intent(in)    :: aperture          
    type(cube_prod_t),            intent(in)    :: stackprod
    type(cube_t), pointer,        intent(inout) :: stacked
    logical,                      intent(inout) :: error
    !
    type(stack_spectral_prog_t) :: prog
    character(len=*), parameter :: rname='STACK>SPECTRAL>APERTURE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call prog%init(domean,window,cube,center,aperture,stackprod,stacked,error)
    if (error) return
    call prog%header(error)
    if (error) return
    call prog%data(error)
    if (error) return
  end subroutine cubemain_stack_spectral_aperture
  !
  !----------Common-code-base--------------------------------------------
  !
  subroutine cubemain_stack_spectral_allocate(prog,error)
    use gkernel_interfaces
    use cubetools_shape_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    ! allocates stack_spectral_prog_t
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    logical,                      intent(inout) :: error
    !
    type(shape_t) :: n
    integer(kind=4) :: ier,iw
    character(len=*), parameter :: rname='STACK>SPECTRAL>ALLOCATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_header_get_array_shape(prog%cube%head,n,error)
    if (error) return
    allocate(prog%include(n%c),stat=ier)
    if (failed_allocate(rname,'Channels to be included',ier,error)) return
    prog%include(:) = .false.
    do iw=1,prog%wind%n
       prog%include(prog%wind%val(iw)%o(1):prog%wind%val(iw)%o(2)) = .true.
    enddo ! iw
  end subroutine cubemain_stack_spectral_allocate
  !
  subroutine cubemain_stack_spectral_header_set_scale(prog,error)
    use cubetools_header_methods
    use cubetools_brightness
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    logical,                      intent(inout) :: error
    !
    logical :: valid
    integer(kind=code_k) :: incode
    character(len=unit_l) :: inunit,ouunit
    real(kind=sign_k), parameter :: feff=1.0
    real(kind=sign_k), parameter :: beff=1.0
    character(len=*), parameter :: rname='STACK>SPECTRAL>HEADER>SET>SCALE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_header_get_array_unit(prog%cube%head,inunit,error)
    if (error) return
    call cubetools_brightness_valid_brightness_unit(inunit,incode,valid,error)
    if (error) return
    if (valid) then
       if (prog%domean) then
          call cubetools_header_brightness2brightness(prog%cube%head,&
               .not.applyeff,feff,beff,code_unit_tmb,prog%factor,error)
          if (error) return
          ouunit = brightness_get(code_unit_tmb)
       else
          call cubetools_header_brightness2flux(prog%cube%head,code_unit_jy,prog%factor,error)
          if (error) return
          ouunit = flux_get(code_unit_jy)
       endif
    else
       prog%factor = 1
       ouunit = inunit
    endif
    call cubetools_header_put_array_unit(ouunit,prog%stacked%head,error)
    if (error) return
  end subroutine cubemain_stack_spectral_header_set_scale
  !
  subroutine cubemain_stack_spectral_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    logical,                      intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='STACK>SPECTRAL>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,error) FIRSTPRIVATE(iter)
       if (.not.error) then
          call prog%loop(iter,error)
       endif
       !$OMP END TASK
    enddo ! iter
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_stack_spectral_data
  !
  subroutine cubemain_stack_spectral_get_weight_image(prog,iter,weight,error)
    use cubeadm_image_types
    use cubeadm_taskloop
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(in)    :: prog
    type(cubeadm_iterator_t),     intent(in)    :: iter
    type(image_t),                intent(out)   :: weight
    logical,                      intent(inout) :: error
    !
    integer(kind=pixe_k) :: ix,iy
    character(len=*), parameter :: rname='STACK>SPECTRAL>GET>WEIGHT>IMAGE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (prog%donoise) then
       call weight%associate('weight',prog%noise,iter,error)
       if (error) return
       call weight%get(one,error)
       if (error) return
       do iy=1,weight%ny
          do ix=1,weight%nx
             weight%val(ix,iy) = 1/weight%val(ix,iy)**2
          enddo ! ix
       enddo ! iy
    else
       call weight%allocate('weight',prog%cube,iter,error)
       if (error) return
       do iy=1,weight%ny
          do ix=1,weight%nx
             weight%val(ix,iy) = 1
          enddo ! ix
       enddo ! iy
    endif
  end subroutine cubemain_stack_spectral_get_weight_image
  ! 
  subroutine cubemain_stack_spectral_act_nomask(prog,image,weight,stacked,error)
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(in)    :: prog
    type(image_t),                intent(in)    :: image
    type(image_t),                intent(in)    :: weight
    type(image_t),                intent(inout) :: stacked
    logical,                      intent(inout) :: error
    !
    real(kind=sign_k) :: val,wei
    integer(kind=pixe_k) :: ix,iy
    character(len=*), parameter :: rname='STACK>SPECTRAL>ACT>NOMASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    val = 0
    wei = 0
    if (prog%contaminate) then
       do iy=1,image%ny
          do ix=1,image%nx
             val = val + image%val(ix,iy)*weight%val(ix,iy)
             wei = wei + weight%val(ix,iy)
          enddo ! ix
       enddo ! iy
    else
       do iy=1,image%ny
          do ix=1,image%nx
             if (.not.ieee_is_nan(image%val(ix,iy)).and..not.ieee_is_nan(weight%val(ix,iy))) then
                val = val + image%val(ix,iy)*weight%val(ix,iy)
                wei = wei + weight%val(ix,iy)
             endif
          enddo ! ix
       enddo ! iy
    endif
    if (wei.gt.0) then
       stacked%val(one,one) = val/wei*prog%factor
    else
       stacked%val(one,one) = gr4nan
    endif
  end subroutine cubemain_stack_spectral_act_nomask
  !
  subroutine cubemain_stack_spectral_act_mask(prog,image,weight,mask,stacked,error)
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(in)    :: prog
    type(image_t),                intent(in)    :: image
    type(image_t),                intent(in)    :: weight
    type(image_t),                intent(in)    :: mask
    type(image_t),                intent(inout) :: stacked
    logical,                      intent(inout) :: error
    !
    real(kind=sign_k) :: val,wei
    integer(kind=pixe_k) :: ix,iy
    character(len=*), parameter :: rname='STACK>SPECTRAL>ACT>MASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    val = 0
    wei = 0
    if (prog%contaminate) then
       do iy=1,image%ny
          do ix=1,image%nx
             if (.not.ieee_is_nan(mask%val(ix,iy))) then
                val = val + image%val(ix,iy)*weight%val(ix,iy)
                wei = wei + weight%val(ix,iy)*mask%val(ix,iy)
             endif
          enddo ! ix
       enddo ! iy
    else
       do iy=1,image%ny
          do ix=1,image%nx
             if (.not.ieee_is_nan(image%val(ix,iy)).and..not.ieee_is_nan(weight%val(ix,iy))&
                  .and..not.ieee_is_nan(mask%val(ix,iy))) then
                val = val + image%val(ix,iy)*weight%val(ix,iy)
                wei = wei + weight%val(ix,iy)
             endif
          enddo ! ix
       enddo ! iy
    endif
    if (wei.gt.0) then
       stacked%val(one,one) = val/wei*prog%factor
    else
       stacked%val(one,one) = gr4nan
    endif
  end subroutine cubemain_stack_spectral_act_mask
  !
  !----------Aperture-specific-------------------------------------------
  !
  subroutine cubemain_stack_spectral_aperture_init(prog,domean,wind,cube,  &
    center,aperture,stackprod,stacked,error)
    !----------------------------------------------------------------------
    ! Initializes stack_spectral_prog_t
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t),  intent(out)   :: prog
    logical,                       intent(in)    :: domean
    type(window_array_t), target,  intent(in)    :: wind
    type(cube_t),         pointer, intent(in)    :: cube
    type(spapos_prog_t),  target,  intent(in)    :: center            
    type(ellipse_prog_t), target,  intent(in)    :: aperture          
    type(cube_prod_t),             intent(in)    :: stackprod
    type(cube_t),         pointer, intent(in)    :: stacked
    logical,                       intent(inout) :: error
    !
    character(len=*), parameter :: rname='STACK>SPECTRAL>APERTURE>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    prog%domean = domean
    prog%wind => wind
    prog%cube => cube
    prog%domask = .false.
    prog%mask2d = .false.
    prog%mask => null()
    prog%donoise = .false.
    prog%noise => null()
    prog%stacked => stacked
    prog%center => center
    prog%aperture => aperture
    !
    prog%contaminate = .false.
    !
    ! Do a copy (for symetry with the noaperture case)
    call stackprod%copy(prog%stackprod,error)
    if (error)  return
    !
    call prog%allocate(error)
    if (error) return
    !
    prog%header => cubemain_stack_spectral_aperture_header
    prog%loop   => cubemain_stack_spectral_aperture_loop
  end subroutine cubemain_stack_spectral_aperture_init
  !
  subroutine cubemain_stack_spectral_aperture_header(prog,error)
    use phys_const
    use gkernel_types, only: projection_t
    use cubetools_header_methods
    use cubetools_axis_types
    use cubetools_beam_types
    use cubetools_spapro_types
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    logical,                      intent(inout) :: error
    !
    type(projection_t) :: gproj
    type(spapro_t) :: spapro
    type(axis_t) :: axis
    type(beam_t) :: beam
    character(len=*), parameter :: rname='STACK>SPECTRAL>APERTURE>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(prog%stackprod,prog%cube,prog%stacked,error)
    if (error) return
    !
    call prog%header_setscale(error)
    if (error) return
    !
    ! VVV The following code aproximates the header to describe a
    ! shape similar to the aperture. L axis is aligned with aperture
    ! major axis, m axis with the minor axis, projection angle is the
    ! aperture position angle. This is only an approximation as the
    ! projection effects are not taken into account.
    !
    ! l axis
    call cubetools_header_get_axis_head_l(prog%stacked%head,axis,error)
    if (error) return
    axis%ref = 0.0
    axis%val = 0.0
    if (prog%aperture%major.gt.abs(axis%inc)) axis%inc = prog%aperture%major
    axis%n = 1_pixe_k
    call cubetools_header_update_axset_l(axis,prog%stacked%head,error)
    if (error) return
    !
    ! m axis
    call cubetools_header_get_axis_head_m(prog%stacked%head,axis,error)
    if (error) return
    axis%ref = 0.0
    axis%val = 0.0
    if (prog%aperture%minor.gt.abs(axis%inc)) axis%inc = prog%aperture%minor
    axis%n = 1_pixe_k
    call cubetools_header_update_axset_m(axis,prog%stacked%head,error)
    if (error) return
    !
    ! Projection
    call cubetools_header_get_spapro(prog%stacked%head,spapro,gproj,error)
    if (error) return
    spapro%l0 = prog%center%abso(1)
    spapro%m0 = prog%center%abso(2)
    spapro%pa = prog%aperture%pang
    call cubetools_header_put_spapro(spapro,prog%stacked%head,error)
    if (error) return
    !
    ! Beam
    call cubetools_header_get_spabeam(prog%stacked%head,beam,error)
    if (error) return
    ! VVV is this the correct choice for the output beam?
    if (beam%major*beam%minor.lt.prog%aperture%major*prog%aperture%minor) then
       beam%major = prog%aperture%major
       beam%minor = prog%aperture%minor
       beam%pang  = prog%aperture%pang
       call cubetools_header_update_spabeam(beam,prog%stacked%head,error)
       if (error) return
    endif
  end subroutine cubemain_stack_spectral_aperture_header
  !
  subroutine cubemain_stack_spectral_aperture_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    type(cubeadm_iterator_t),     intent(inout) :: iter
    logical,                      intent(inout) :: error
    !
    type(image_t) :: image,stacked,weight,mask
    character(len=*), parameter :: rname='STACK>SPECTRAL>APERTURE>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call image%associate('image',prog%cube,iter,error)
    if (error) return
    call stacked%allocate('stacked',prog%stacked,iter,error)
    if (error) return
    call prog%aperture%tomask(prog%center,iter,mask,error)
    if (error) return
    call prog%get(iter,weight,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
       if (prog%include(iter%ie)) then
          call image%get(iter%ie,error)
          if (error) return
          call prog%act_mask(image,weight,mask,stacked,error)
          if (error) return
       else
          stacked%val(one,one) = gr4nan
       endif
       call stacked%put(iter%ie,error)
       if (error) return
    enddo ! ie
  end subroutine cubemain_stack_spectral_aperture_loop
  !
  !----------No-aperture-code--------------------------------------------
  !
  subroutine cubemain_stack_spectral_noaperture_init(prog,domean,wind,cube,domask,&
       mask,donoise,noise,stackprod,stacked,error)
    use cubetools_shape_types
    use cubetools_header_methods
    use cubedag_allflags
    !----------------------------------------------------------------------
    ! Initializes stack_spectral_prog_t
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t),  intent(out)   :: prog
    logical,                       intent(in)    :: domean
    type(window_array_t), target,  intent(in)    :: wind
    type(cube_t),         pointer, intent(in)    :: cube
    logical,                       intent(in)    :: domask
    type(cube_t),         pointer, intent(in)    :: mask
    logical,                       intent(in)    :: donoise
    type(cube_t),         pointer, intent(in)    :: noise
    type(cube_prod_t),             intent(in)    :: stackprod
    type(cube_t),         pointer, intent(in)    :: stacked
    logical,                       intent(inout) :: error
    !
    type(shape_t) :: n
    character(len=*), parameter :: rname='STACK>SPECTRAL>NOAPERTURE>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    prog%domean = domean
    prog%wind => wind
    prog%cube => cube
    prog%domask = domask
    prog%mask => mask
    prog%donoise = donoise
    prog%noise => noise
    prog%stacked => stacked
    prog%center => null()
    prog%aperture => null()
    !
    prog%contaminate = .false.
    !
    ! Do not replace the flag in-place, do it in a copy
    call stackprod%copy(prog%stackprod,error)
    if (error)  return
    call prog%stackprod%flag_to_flag(flag_image_or_spectrum,flag_spectrum,error)
    if (error)  return
    !
    call prog%allocate(error)
    if (error) return
    !
    prog%header => cubemain_stack_spectral_noaperture_header
    if (prog%domask) then
       call cubetools_header_get_array_shape(prog%mask%head,n,error)
       if (error) return
       prog%mask2d = n%c.eq.1
       prog%loop => cubemain_stack_spectral_noaperture_loop_mask
    else       
       prog%loop => cubemain_stack_spectral_noaperture_loop_nomask
    endif
  end subroutine cubemain_stack_spectral_noaperture_init
  !
  subroutine cubemain_stack_spectral_noaperture_header(prog,error)
    use phys_const
    use cubetools_header_methods
    use cubetools_axis_types
    use cubetools_beam_types
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    logical,                      intent(inout) :: error
    !
    real(kind=coor_k) :: size(2)
    type(axis_t) :: axis
    type(beam_t) :: beam
    !
    character(len=*), parameter :: rname='STACK>SPECTRAL>HEADER>NOAPERTURE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(prog%stackprod,prog%cube,prog%stacked,error)
    if (error) return
    !
    call prog%header_setscale(error)
    if (error) return
    !
    ! l axis
    call cubetools_header_get_axis_head_l(prog%stacked%head,axis,error)
    if (error) return
    ! *** JP The following code is only a first approximation. We want:
    ! *** JP 1. to set the position to the average of the unprojected sky position
    ! *** JP    inside the mask. For the moment, take the projection center.
    ! *** JP 2. to set the increment to the rms of the unprojected sky distance from
    ! *** JP    the averaged position. For the moment, take the size of the image.
    size(1) = abs(axis%inc*axis%n)
    axis%ref = 0.0
    axis%val = 0.0
    axis%inc = size(1)
    axis%n = 1_pixe_k
    call cubetools_header_update_axset_l(axis,prog%stacked%head,error)
    if (error) return
    !
    ! m axis
    call cubetools_header_get_axis_head_m(prog%stacked%head,axis,error)
    if (error) return
    ! *** JP The following code is only a first approximation. We want:
    ! *** JP 1. to set the position to the average of the unprojected sky position
    ! *** JP    inside the mask. For the moment, take the projection center.
    ! *** JP 2. to set the increment to the rms of the unprojected sky distance from
    ! *** JP    the averaged position. For the moment, take the size of the image.
    size(2) = abs(axis%inc*axis%n)
    axis%ref = 0.0
    axis%val = 0.0
    axis%inc = size(2)
    axis%n = 1_pixe_k
    call cubetools_header_update_axset_m(axis,prog%stacked%head,error)
    if (error) return
    !
    ! Beam
    call cubetools_header_get_spabeam(prog%stacked%head,beam,error)
    if (error) return
    beam%major = max(size(1),size(2))
    beam%minor = min(size(1),size(2))
    ! *** JP Unclear whether this is the correct angle convention
    if (size(1).ge.size(2)) then
       beam%pang = 0.0
    else
       beam%pang = pi/2
    endif
    call cubetools_header_update_spabeam(beam,prog%stacked%head,error)
    if (error) return
  end subroutine cubemain_stack_spectral_noaperture_header
  !
  subroutine cubemain_stack_spectral_noaperture_loop_nomask(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    type(cubeadm_iterator_t),     intent(inout) :: iter
    logical,                      intent(inout) :: error
    !
    type(image_t) :: image,stacked,weight
    character(len=*), parameter :: rname='STACK>SPECTRAL>NOAPERTURE>LOOP>NOMASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call image%associate('image',prog%cube,iter,error)
    if (error) return
    call prog%get(iter,weight,error)
    if (error) return
    call stacked%allocate('stacked',prog%stacked,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
       if (prog%include(iter%ie)) then
          call image%get(iter%ie,error)
          if (error) return
          call prog%act_nomask(image,weight,stacked,error)
          if (error) return
       else
          stacked%val(one,one) = gr4nan
       endif
       call stacked%put(iter%ie,error)
       if (error) return
    enddo ! ie
  end subroutine cubemain_stack_spectral_noaperture_loop_nomask
  !
  subroutine cubemain_stack_spectral_noaperture_loop_mask(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(stack_spectral_prog_t), intent(inout) :: prog
    type(cubeadm_iterator_t),     intent(inout) :: iter
    logical,                      intent(inout) :: error
    !
    type(image_t) :: image,stacked,weight,mask
    character(len=*), parameter :: rname='STACK>SPECTRAL>NOAPERTURE>LOOP>MASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call image%associate('image',prog%cube,iter,error)
    if (error) return
    call mask%associate('mask',prog%mask,iter,error)
    if (error) return
    call prog%get(iter,weight,error)
    if (error) return
    call stacked%allocate('stacked',prog%stacked,iter,error)
    if (error) return
    !
    if (prog%mask2d) then
      call mask%get(one,error)
      if (error) return 
    endif
    do while (iter%iterate_entry(error))
       if (prog%include(iter%ie)) then
          if (.not.prog%mask2d) then
             call mask%get(iter%ie,error)
             if (error) return 
          endif
          call image%get(iter%ie,error)
          if (error) return
          call prog%act_mask(image,weight,mask,stacked,error)
          if (error) return
       else
          stacked%val(one,one) = gr4nan
       endif
       call stacked%put(iter%ie,error)
       if (error) return
    enddo ! ie
  end subroutine cubemain_stack_spectral_noaperture_loop_mask
end module cubemain_stack_spectral
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
