!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_stack_spatial
  use cubetools_shape_types
  use cube_types
  use cubeadm_cubeprod_types
  use cubemain_spectrum_real
  use cubemain_windowing
  use cubemain_messaging
  !
  public :: cubemain_stack_spatial_do
  private
  !
  integer(kind=entr_k), parameter :: one = 1
  !
  type stack_spatial_prog_t
     type(window_array_t), pointer :: wind               ! Window to be spatially stacked
     type(cube_t), pointer         :: incube             ! Input cube
     type(cube_prod_t)             :: ouprod             ! Output spectrum description
     type(cube_t), pointer         :: oucube             ! Output spectrum
     type(cube_t), pointer         :: mask               ! Mask
     real(kind=sign_k)             :: factor             ! brightness conversion factor
     type(shape_t)                 :: nin                ! Shape of input cube
     logical                       :: contaminate        ! NaNs contaminate image
     logical                       :: mask2d = .false.   ! Is the mask 2d?
     logical                       :: domean = .false.   ! Output is a mean spectrum
     logical                       :: domask             ! Use a mask
  end type stack_spatial_prog_t
  !
contains
  !   
  subroutine cubemain_stack_spatial_init(domean,wind,incube,domask,&
       mask2d,mask,ouprod,oucube,job,error)
    use cubetools_header_methods
    use cubedag_allflags
    !----------------------------------------------------------------------
    ! Initializes stack_spatial_prog_t
    !----------------------------------------------------------------------
    logical,                     intent(in)    :: domean
    type(window_array_t),target, intent(in)    :: wind
    type(cube_t),pointer,        intent(in)    :: incube
    logical,                     intent(in)    :: domask
    logical,                     intent(in)    :: mask2d
    type(cube_t),pointer,        intent(in)    :: mask
    type(cube_prod_t),           intent(in)    :: ouprod
    type(cube_t),pointer,        intent(in)    :: oucube
    type(stack_spatial_prog_t),  intent(out)   :: job
    logical,                     intent(inout) :: error
    !
    character(len=*), parameter :: rname='STACK>SPATIAL>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    job%domean  =  domean
    job%wind    => wind
    job%incube  => incube
    job%domask  =  domask
    job%mask2d  =  mask2d
    job%mask    => mask
    job%oucube  => oucube
    !
    ! Do not replace the flag in-place, do it in a copy
    call ouprod%copy(job%ouprod,error)
    if (error)  return
    call job%ouprod%flag_to_flag(flag_image_or_spectrum,flag_image,error)
    if (error)  return
    !
    call cubetools_header_get_array_shape(job%incube%head,job%nin,error)
    if (error) return
    !
    job%contaminate = .true.
  end subroutine cubemain_stack_spatial_init
  !
  subroutine cubemain_stack_spatial_do(domean,wind,incube,domask,&
       mask2d,mask,ouprod,oucube,error)
    !----------------------------------------------------------------------
    ! Does the job
    !----------------------------------------------------------------------
    logical,                     intent(in)    :: domean
    type(window_array_t),        intent(in)    :: wind
    type(cube_t),pointer,        intent(inout) :: incube
    logical,                     intent(in)    :: domask
    logical,                     intent(in)    :: mask2d
    type(cube_t),pointer,        intent(inout) :: mask
    type(cube_prod_t), target,   intent(in)    :: ouprod
    type(cube_t),pointer,        intent(inout) :: oucube
    logical,                     intent(inout) :: error
    !
    type(stack_spatial_prog_t) :: job
    character(len=*), parameter :: rname='STACK>SPATIAL>DO'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_stack_spatial_init(domean,wind,incube,domask,&
         mask2d,mask,ouprod,oucube,job,error)
    if (error) return
    !
    call cubemain_stack_spatial_header(job,error)
    if (error) return
    call cubemain_stack_spatial_data(job,error)
    if (error) return
  end subroutine cubemain_stack_spatial_do
  !
  subroutine cubemain_stack_spatial_header(job,error)
    use cubeadm_clone
    use cubetools_axis_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(stack_spatial_prog_t), intent(inout) :: job
    logical,                    intent(inout) :: error
    !
    character(len=unit_l) :: unitin,unitou
    character(len=*), parameter :: rname='STACK>SPATIAL>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(job%ouprod,job%incube,job%oucube,error)
    if (error) return    
    !
    call cubetools_header_put_nchan(one,job%oucube%head,error)
    if (error) return
    call cubetools_header_multiply_spectral_spacing(job%nin%c,job%oucube%head,error)
    if (error) return
    call cubetools_header_rederive_spectral_axes(job%oucube%head,error)
    if (error) return
    if (job%domean) then
       job%factor = 1.0
    else
       call cubetools_header_get_array_unit(job%incube%head,unitin,error)
       if (error) return
       unitou = trim(unitin)//'.km/s'
       call cubetools_header_put_array_unit(unitou,job%oucube%head,error)
       if (error) return
       job%factor = job%incube%head%spe%inc%v
    endif
  end subroutine cubemain_stack_spatial_header
  !
  subroutine cubemain_stack_spatial_data(job,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(stack_spatial_prog_t), intent(inout) :: job
    logical,                    intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='STACK>SPATIAL>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !
    !$OMP PARALLEL DEFAULT(none) SHARED(job,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error) exit
       !$OMP TASK SHARED(job,error) FIRSTPRIVATE(iter)
       if (.not.error) then
          if (job%domask) then
             call cubemain_stack_spatial_mask(job,iter,error)
          else
             call cubemain_stack_spatial_nomask(job,iter,error)
          endif
       endif
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
    !
  end subroutine cubemain_stack_spatial_data
  !
  subroutine cubemain_stack_spatial_nomask(job,iter,error)
    use cubeadm_taskloop
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(stack_spatial_prog_t), intent(inout) :: job
    type(cubeadm_iterator_t),   intent(inout) :: iter
    logical,                    intent(inout) :: error
    !
    type(spectrum_t) :: inspec,ouspec
    character(len=*), parameter :: rname='STACK>SPATIAL>NOMASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call inspec%reassociate_and_init(job%incube,iter,error)
    if (error) return
    call ouspec%reallocate('stacked',one,iter,error)
    if (error) return
    call cubemain_window2mask(job%wind,inspec,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
       call inspec%get(job%incube,iter%ie,error)
       if (error) return
       call cubemain_stack_spatial_spectrum_nomask(job,inspec,ouspec,error)
       if (error) return
       call ouspec%put(job%oucube,iter%ie,error)
       if (error) return
    enddo
  end subroutine cubemain_stack_spatial_nomask
  !
  subroutine cubemain_stack_spatial_mask(job,iter,error)
    use cubetools_nan
    use cubeadm_taskloop
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(stack_spatial_prog_t), intent(inout) :: job
    type(cubeadm_iterator_t),   intent(inout) :: iter
    logical,                    intent(inout) :: error
    !
    type(spectrum_t) :: inspec,ouspec,mask
    character(len=*), parameter :: rname='STACK>SPATIAL>MASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call inspec%reassociate_and_init(job%incube,iter,error)
    if (error) return
    call mask%reassociate_and_init(job%mask,iter,error)
    if (error) return
    call ouspec%reallocate('stacked',one,iter,error)
    if (error) return
    call cubemain_window2mask(job%wind,inspec,error)
    if (error) return
    !
    if (job%mask2d) then
       do while (iter%iterate_entry(error))
          call mask%get(job%mask,iter%ie,error)
          if (error) return
          if (ieee_is_nan(mask%t(one))) then
             ouspec%t(one) = gr4nan
          else
             call inspec%get(job%incube,iter%ie,error)
             if (error) return       
             call cubemain_stack_spatial_spectrum_nomask(job,inspec,ouspec,error)
             if (error) return
          endif
          call ouspec%put(job%oucube,iter%ie,error)
          if (error) return
       enddo
    else
       do while (iter%iterate_entry(error))
          call mask%get(job%mask,iter%ie,error)
          if (error) return
          call inspec%get(job%incube,iter%ie,error)
          if (error) return       
          call cubemain_stack_spatial_spectrum_mask(job,inspec,mask,ouspec,error)
          if (error) return
          call ouspec%put(job%oucube,iter%ie,error)
          if (error) return
       enddo
    endif
  end subroutine cubemain_stack_spatial_mask
  !
  subroutine cubemain_stack_spatial_spectrum_nomask(job,inspec,ouspec,error)
    use cubetools_nan
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(stack_spatial_prog_t), intent(in)    :: job
    type(spectrum_t),           intent(in)    :: inspec
    type(spectrum_t),           intent(inout) :: ouspec
    logical,                    intent(inout) :: error
    !
    real(kind=sign_k) :: val,wei
    integer(kind=chan_k) :: ic
    character(len=*), parameter :: rname='STACK>SPATIAL>SPECTRUM>NOMASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    val = 0
    wei = 0
    if (job%contaminate) then
       do ic=1,job%nin%c
          val = val + inspec%t(ic)*inspec%w(ic)
          wei = wei + inspec%w(ic)
       enddo
    else
       do ic=1,job%nin%c
          if (.not.ieee_is_nan(inspec%t(ic)).and.inspec%w(ic).gt.0) then
             val = val + inspec%t(ic)*inspec%w(ic)
             wei = wei + inspec%w(ic)
          endif
       enddo
    endif
    if (wei.gt.0) then
       ! *** JP: Ugly patch
       if (job%domean) then
          ouspec%t(one) = val/wei*job%factor
       else
          ouspec%t(one) = val*job%factor
       endif
       ! *** JP: Ugly patch
    else
       ouspec%t(one) = gr4nan
    endif
  end subroutine cubemain_stack_spatial_spectrum_nomask
  !
  subroutine cubemain_stack_spatial_spectrum_mask(job,inspec,mask,ouspec,error)
    use cubetools_nan
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(stack_spatial_prog_t), intent(in)    :: job
    type(spectrum_t),           intent(in)    :: inspec
    type(spectrum_t),           intent(in)    :: mask
    type(spectrum_t),           intent(inout) :: ouspec
    logical,                    intent(inout) :: error
    !
    real(kind=sign_k) :: val,wei
    integer(kind=chan_k) :: ic
    character(len=*), parameter :: rname='STACK>SPATIAL>SPECTRUM>MASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    val = 0
    wei = 0
    if (job%contaminate) then
       do ic=1,job%nin%c
          if (.not.ieee_is_nan(mask%t(ic))) then
             val = val + inspec%t(ic)*inspec%w(ic)
             wei = wei + inspec%w(ic)
          endif
       enddo
    else
       do ic=1,job%nin%c
          if (.not.ieee_is_nan(inspec%t(ic)).and..not.ieee_is_nan(mask%t(ic))) then
             val = val + inspec%t(ic)*inspec%w(ic)
             wei = wei + inspec%w(ic)
          endif
       enddo
    endif
    if (wei.gt.0) then
       ! *** JP: Ugly patch
       if (job%domean) then
          ouspec%t(one) = val/wei*job%factor
       else
          ouspec%t(one) = val*job%factor
       endif
       ! *** JP: Ugly patch
    else
       ouspec%t(one) = gr4nan
    endif
  end subroutine cubemain_stack_spatial_spectrum_mask
end module cubemain_stack_spatial
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
