!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_moments_cube_types
  use cube_types
  use cubetools_parameters
  use cubeadm_cubeprod_types
  use cubemain_messaging
  !
  public :: moments_cubeprodset_t
  public :: moments_cube_t,moments_cubeset_t
  private
  !
  type moments_cubeprod_t
     type(cube_prod_t), pointer :: sig
     type(cube_prod_t), pointer :: noi
     type(cube_prod_t), pointer :: snr
  contains
     procedure, private :: register => moments_cubeprod_register
  end type moments_cubeprod_t
  !
  type moments_cubeprodset_t
     type(moments_cubeprod_t) :: peak ! [     K] Peak intensity
     type(moments_cubeprod_t) :: area ! [*.km/s] Integrated intensity
     type(moments_cubeprod_t) :: velo ! [  km/s] Velocity at peak intensity
     type(moments_cubeprod_t) :: cent ! [  km/s] Centroid velocity
     type(moments_cubeprod_t) :: fwhm ! [  km/s] Full Width at Half Maximum
     type(moments_cubeprod_t) :: eqwd ! [  km/s] area over peak
  contains
     procedure, public :: register => moments_cubeprodset_register
  end type moments_cubeprodset_t
  !
  type moments_cube_t
     type(cube_t), pointer :: sig
     type(cube_t), pointer :: noi
     type(cube_t), pointer :: snr
   contains
     procedure, private :: header => cubemain_moments_cube_header_all
  end type moments_cube_t
  !
  type moments_cubeset_t
     type(moments_cube_t) :: peak ! [     K] Peak intensity
     type(moments_cube_t) :: area ! [*.km/s] Integrated intensity
     type(moments_cube_t) :: velo ! [  km/s] Velocity at peak intensity
     type(moments_cube_t) :: cent ! [  km/s] Centroid velocity
     type(moments_cube_t) :: fwhm ! [  km/s] Full Width at Half Maximum
     type(moments_cube_t) :: eqwd ! [  km/s] area over peak
   contains
     procedure, public :: header => cubemain_moments_cubeset_header
  end type moments_cubeset_t
  !
contains
  !
  subroutine  moments_cubeprodset_register(cubeprodset,error)
    use cubedag_allflags
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(moments_cubeprodset_t), intent(in)    :: cubeprodset
    logical,                      intent(inout) :: error
    !
    call cubeprodset%peak%register('PEAKB','Peak brightness',&
         [flag_peak,flag_brightness],error)
    if (error) return
    call cubeprodset%velo%register('PEAKV','Peak velocity',&
         [flag_peak,flag_velocity],error)
    if (error) return
    call cubeprodset%area%register('AREA','Area',&
         [flag_area],error)
    if (error) return
    call cubeprodset%cent%register('CVELO','Centroid velocity',&
         [flag_centroid,flag_velocity],error)
    if (error) return
    call cubeprodset%fwhm%register('FWHM','FWHM',&
         [flag_fwhm,flag_width],error)
    if (error) return
    call cubeprodset%eqwd%register('EQWIDTH','Equivalent width',&
         [flag_equivalent,flag_width],error)
    if (error) return
  end subroutine moments_cubeprodset_register
  !
  subroutine moments_cubeprod_register(moments,name,hlp,flag_momkind,error)
    use cubedag_allflags
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(moments_cubeprod_t), intent(in)    :: moments
    character(len=*),          intent(in)    :: name
    character(len=*),          intent(in)    :: hlp
    type(flag_t),              intent(in)    :: flag_momkind(:)
    logical,                   intent(inout) :: error
    !
    type(cube_prod_t) :: oucube
    !
    call oucube%register(&
         name//'SIG',&
         hlp//' signal',&
         strg_id,&
         [flag_moment,flag_momkind(:),flag_signal],&
         moments%sig,&
         error)
    if (error) return
    call oucube%register(&
         name//'NOI',&
         hlp//' noise',&
         strg_id,&
         [flag_moment,flag_momkind(:),flag_noise],&
         moments%noi,&
         error)
    if (error) return
    call oucube%register(&
         name//'SNR',&
         hlp//' SNR',&
         strg_id,&
         [flag_moment,flag_momkind(:),flag_snr],&
         moments%snr,&
         error)
    if (error) return
  end subroutine moments_cubeprod_register
  !
  subroutine cubemain_moments_cubeset_header(cubeset,prodset,cube,nw,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(moments_cubeset_t),    intent(inout) :: cubeset
    type(moments_cubeprodset_t), intent(in)    :: prodset
    type(cube_t), pointer,       intent(in)    :: cube
    integer(kind=wind_k),        intent(in)    :: nw
    logical,                     intent(inout) :: error
    !
    character(len=unit_l) :: unit
    character(len=*), parameter :: rname='MOMENTS>CUBESET>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    unit = cube%head%arr%unit 
    call cubeset%peak%header(prodset%peak,unit,nw,cube,error)
    if (error) return
    call cubeset%velo%header(prodset%velo,'km/s',nw,cube,error)
    if (error) return
    call cubeset%area%header(prodset%area,trim(unit)//'.km/s',nw,cube,error)
    if (error) return
    call cubeset%cent%header(prodset%cent,'km/s',nw,cube,error)
    if (error) return
    call cubeset%fwhm%header(prodset%fwhm,'km/s',nw,cube,error)
    if (error) return
    call cubeset%eqwd%header(prodset%eqwd,'km/s',nw,cube,error)
    if (error) return
  end subroutine cubemain_moments_cubeset_header
  !
  subroutine cubemain_moments_cube_header_all(moments,momprod,unit,nw,cube,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(moments_cube_t),    intent(inout) :: moments
    type(moments_cubeprod_t), intent(in)    :: momprod
    character(len=*),         intent(in)    :: unit
    integer(kind=wind_k),     intent(in)    :: nw
    type(cube_t), pointer,    intent(in)    :: cube
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='MOMENTS>CUBE>HEADER>ALL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_moments_cube_header_one(moments%sig,momprod%sig,&
         unit,nw,cube,error)
    if (error) return
    call cubemain_moments_cube_header_one(moments%noi,momprod%noi,&
         unit,nw,cube,error)
    if (error) return
    call cubemain_moments_cube_header_one(moments%snr,momprod%snr,&
         '---',nw,cube,error)
    if (error) return
  end subroutine cubemain_moments_cube_header_all
  !
  subroutine cubemain_moments_cube_header_one(ou,cubeprod,unit,nw,in,error)
    use cubeadm_clone
    use cubetools_axis_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_t), pointer, intent(inout) :: ou
    type(cube_prod_t),     intent(in)    :: cubeprod
    character(len=*),      intent(in)    :: unit
    integer(kind=wind_k),  intent(in)    :: nw
    type(cube_t), pointer, intent(in)    :: in
    logical,               intent(inout) :: error
    !
    type(axis_t) :: axis
    character(len=*), parameter :: rname='MOMENTS>CUBE>HEADER>ONE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(cubeprod,in,ou,error)
    if (error) return
    call cubetools_header_put_array_unit(unit,ou%head,error)
    if (error) return
    call cubetools_header_get_axis_head_c(ou%head,axis,error)
    if (error) return
    axis%n = nw
    axis%ref = 1d0
    axis%val = 0d0
    call cubetools_header_update_axset_c(axis,ou%head,error)
    if (error) return
  end subroutine cubemain_moments_cube_header_one  
end module cubemain_moments_cube_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_moments_spec_types
  use cubetools_parameters
  use cubemain_messaging
  use cubemain_spectrum_real
  use cubemain_spectrum_moment_tool
  !
  public :: moments_spec_t
  private
  !
  type moments_spec_t
     type(spectrum_t) :: sig
     type(spectrum_t) :: noi
     type(spectrum_t) :: snr
   contains
     procedure, public :: reallocate => cubemain_moments_spec_reallocate
     procedure, public :: get        => cubemain_moments_spec_get
     procedure, public :: put        => cubemain_moments_spec_put
  end type moments_spec_t
  !
contains
  !
  subroutine cubemain_moments_spec_reallocate(spec,kind,nw,iterator,error)
    use cubeadm_taskloop
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_spec_t),    intent(inout) :: spec
    character(len=*),         intent(in)    :: kind
    integer(kind=wind_k),     intent(in)    :: nw
    type(cubeadm_iterator_t), intent(in)    :: iterator
    logical,                  intent(inout) :: error
    !
    integer(kind=chan_k) :: mw
    character(len=*), parameter :: rname='MOMENTS>SPEC>REALLOCATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    mw = int(nw,kind=chan_k)
    call spec%sig%reallocate(kind//'-sig',mw,iterator,error)
    if (error) return
    call spec%noi%reallocate(kind//'-noi',mw,iterator,error)
    if (error) return
    call spec%snr%reallocate(kind//'-snr',mw,iterator,error)
    if (error) return
  end subroutine cubemain_moments_spec_reallocate
  !
  subroutine cubemain_moments_spec_get(spec,iw,val,error)
    use cubemain_spectrum_moment_tool
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(moments_spec_t),    intent(inout) :: spec
    integer(kind=wind_k),     intent(in)    :: iw
    class(spectrum_moment_t), intent(in)    :: val
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='MOMENTS>SPEC>GET'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    spec%sig%t(iw) = val%sig
    spec%noi%t(iw) = val%noi
    spec%snr%t(iw) = val%snr
  end subroutine cubemain_moments_spec_get
  !
  subroutine cubemain_moments_spec_put(spec,cube,ie,error)
    use cubemain_moments_cube_types
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_spec_t), intent(in)    :: spec
    type(moments_cube_t),  intent(inout) :: cube
    integer(kind=entr_k),  intent(in)    :: ie
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='MOMENTS>SPEC>PUT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call spec%sig%put(cube%sig,ie,error)
    if (error) return
    call spec%noi%put(cube%noi,ie,error)
    if (error) return
    call spec%snr%put(cube%snr,ie,error)
    if (error) return
  end subroutine cubemain_moments_spec_put
end module cubemain_moments_spec_types
!
module cubemain_moments_specset_types
  use cubetools_parameters
  use cubemain_messaging
  use cubemain_moments_spec_types
  !
  public :: moments_specset_t
  private
  !
  type moments_specset_t
     type(moments_spec_t) :: peak ! [     *] Peak intensity
     type(moments_spec_t) :: velo ! [  km/s] Velocity at peak intensity
     type(moments_spec_t) :: area ! [*.km/s] Integrated intensity
     type(moments_spec_t) :: cent ! [  km/s] Centroid velocity
     type(moments_spec_t) :: fwhm ! [  km/s] Full Width at Half Maximum
     type(moments_spec_t) :: eqwd ! [  km/s] area over peak
   contains
     procedure, public :: reallocate => cubemain_moments_specset_reallocate
     procedure, public :: compute    => cubemain_moments_specset_compute
     procedure, public :: put        => cubemain_moments_specset_put
     procedure, public :: null       => cubemain_moments_specset_null
  end type moments_specset_t
  !
contains
  ! 
  subroutine cubemain_moments_specset_reallocate(specset,nw,iterator,error)
    use cubeadm_taskloop
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_specset_t), intent(inout) :: specset
    integer(kind=wind_k),     intent(in)    :: nw
    type(cubeadm_iterator_t), intent(in)    :: iterator
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='MOMENTS>SPECSET>REALLOCATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call specset%peak%reallocate('peak',nw,iterator,error)
    if (error) return
    call specset%area%reallocate('area',nw,iterator,error)
    if (error) return
    call specset%velo%reallocate('velo',nw,iterator,error)
    if (error) return
    call specset%cent%reallocate('cent',nw,iterator,error)
    if (error) return
    call specset%fwhm%reallocate('fwhm',nw,iterator,error)
    if (error) return
    call specset%eqwd%reallocate('eqwd',nw,iterator,error)
    if (error) return
  end subroutine cubemain_moments_specset_reallocate
  !
  subroutine cubemain_moments_specset_compute(specset,spec,first,last,noise,good,iw,error)
    use cubemain_spectrum_real
    use cubemain_spectrum_blanking
    use cubemain_spectrum_moment_tool
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_specset_t), intent(inout) :: specset
    type(spectrum_t),         intent(in)    :: spec
    integer(kind=chan_k),     intent(in)    :: first
    integer(kind=chan_k),     intent(in)    :: last
    real(kind=sign_k),        intent(in)    :: noise    
    type(spectrum_t),         intent(inout) :: good
    integer(kind=wind_k),     intent(in)    :: iw
    logical,                  intent(inout) :: error
    !
    type(spectrum_t) :: line
    type(spectrum_tpeak_t) :: peak
    type(spectrum_vpeak_t) :: velo
    type(spectrum_area_t) :: area
    type(spectrum_cent_t) :: cent
    type(spectrum_fwhm_t) :: fwhm
    type(spectrum_eqwd_t) :: eqwd
    character(len=*), parameter :: rname='MOMENTS>SPECSET>COMPUTE'
    !
    call line%point_to(spec,first,last,noise,error)
    if (error) return
    call cubemain_spectrum_unblank(line,good,error)
    if (error) return
    if (good%n.gt.0) then
       ! Compute
       call peak%compute(good,error)
       if (error) return
       call velo%compute(good,peak,error)
       if (error) return             
       call area%compute(good,error)
       if (error) return
       call cent%compute(good,area,error)
       if (error) return
       call fwhm%compute(good,cent,error)
       if (error) return
       call eqwd%compute(peak,area,error)
       if (error) return
       call specset%peak%get(iw,peak,error)
       if (error) return
       call specset%area%get(iw,area,error)
       if (error) return
       call specset%velo%get(iw,velo,error)
       if (error) return
       call specset%cent%get(iw,cent,error)
       if (error) return
       call specset%fwhm%get(iw,fwhm,error)
       if (error) return
       call specset%eqwd%get(iw,eqwd,error)
       if (error) return
    else
       call specset%null(iw,error)
       if (error) return
    endif
  end subroutine cubemain_moments_specset_compute
  !
  subroutine cubemain_moments_specset_null(specset,iw,error)
    use cubemain_spectrum_moment_tool
    use cubetools_nan
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_specset_t), intent(inout) :: specset
    integer(kind=wind_k),     intent(in)    :: iw
    logical,                  intent(inout) :: error
    !
    type(spectrum_moment_t) :: null
    character(len=*), parameter :: rname='MOMENTS>SPECSET>NULL'
    !
    null%sig = gr4nan
    null%noi = gr4nan
    null%snr = gr4nan
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call specset%peak%get(iw,null,error)
    if (error) return
    call specset%area%get(iw,null,error)
    if (error) return
    call specset%velo%get(iw,null,error)
    if (error) return
    call specset%cent%get(iw,null,error)
    if (error) return
    call specset%fwhm%get(iw,null,error)
    if (error) return
    call specset%eqwd%get(iw,null,error)
    if (error) return
  end subroutine cubemain_moments_specset_null
  !
  subroutine cubemain_moments_specset_put(specset,cubeset,ie,error)
    use cubemain_moments_cube_types    
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_specset_t), intent(in)    :: specset
    type(moments_cubeset_t),  intent(inout) :: cubeset
    integer(kind=entr_k),     intent(in)    :: ie
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='MOMENTS>SPECSET>PUT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call specset%peak%put(cubeset%peak,ie,error)
    if (error) return                                           
    call specset%area%put(cubeset%area,ie,error)
    if (error) return                                           
    call specset%velo%put(cubeset%velo,ie,error)
    if (error) return                                           
    call specset%cent%put(cubeset%cent,ie,error)
    if (error) return                                           
    call specset%fwhm%put(cubeset%fwhm,ie,error)
    if (error) return                                           
    call specset%eqwd%put(cubeset%eqwd,ie,error)
    if (error) return
  end subroutine cubemain_moments_specset_put
end module cubemain_moments_specset_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_moments
  use cubetools_structure
  use cube_types
  use cubeadm_cubeid_types
  use cubemain_messaging
  use cubeadm_ancillary_cube_types
  use cubemain_moments_specset_types
  use cubemain_moments_cube_types
  use cubemain_range
  use cubemain_windowing
  !
  public :: moments
  private
  !
  type :: moments_comm_t
     type(option_t), pointer     :: comm
     type(range_opt_t)           :: range
     type(cubeid_arg_t), pointer :: cube
     type(cubeid_arg_t), pointer :: noise
     type(ancillary_cube_comm_t) :: win
     type(moments_cubeprodset_t) :: moments
   contains
     procedure, public  :: register => cubemain_moments_comm_register
     procedure, private :: parse    => cubemain_moments_comm_parse
     procedure, private :: main     => cubemain_moments_comm_main
  end type moments_comm_t
  type(moments_comm_t) :: moments
  !
  type moments_user_t
     type(cubeid_user_t)         :: cubeids
     type(ancillary_cube_user_t) :: win
     type(range_array_t)         :: range
     logical                     :: dorange = .false.
   contains
     procedure, private :: toprog => cubemain_moments_user_toprog
  end type moments_user_t
  !
  type moments_prog_t
     integer(kind=wind_k)        :: nw = 0  ! Number of windows
     integer(kind=chan_k)        :: nc = 0  ! Maximum number of channels inside one window
     type(window_array_t)        :: glowin ! One set of windows for the full index
     type(ancillary_cube_prog_t) :: locwin ! Number and positions of windows depend on the spectrum
     type(cube_t), pointer       :: noise
     type(cube_t), pointer       :: cube
     type(moments_cubeset_t)     :: moments
   contains
     procedure, private :: data        => cubemain_moments_prog_data
     procedure, private :: header      => cubemain_moments_prog_header
     procedure, private :: loop        => cubemain_moments_prog_loop
     procedure, private :: locwin_loop => cubemain_moments_prog_locwin_loop
     procedure, private :: locwin_act  => cubemain_moments_prog_locwin_act
     procedure, private :: glowin_loop => cubemain_moments_prog_glowin_loop
     procedure, private :: glowin_act  => cubemain_moments_prog_glowin_act
  end type moments_prog_t
  !
contains
  !
  subroutine cubemain_moments_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(moments_user_t) :: user
    character(len=*), parameter :: rname='MOMENTS>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call moments%parse(line,user,error)
    if (error) return
    call moments%main(user,error)
    if (error) continue
  end subroutine cubemain_moments_command
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_moments_comm_register(comm,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(moments_comm_t), intent(inout) :: comm
    logical,               intent(inout) :: error
    !
    type(cubeid_arg_t) :: incube
    character(len=*), parameter :: comm_abstract = &
         'Compute various moments for each spectrum of a cube'
    character(len=*), parameter :: comm_help = &
         'Compute the 3 first moments plus 3 associated quantities&
         & (peak intensity, integrated intensity, velocity at peak&
         & intensity, centroid velocity, velocity FWHM and&
         & equivalent width) for each spectrum in a cube. MOMENTS&
         & uses either a global window to compute the moments &
         &(/RANGE), or individual windows set for each spectrum&
         & (created by CUBE\WINDOW). The associated noise and signal&
         &-to-noise ratio of each moment are also computed.'
    character(len=*), parameter :: rname='MOMENTS>COMM>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'MOMENTS','[signalid [noiseid]]',&
         comm_abstract,&
         comm_help,&
         cubemain_moments_command,&
         comm%comm,&
         error)
    if (error) return
    call incube%register(&
         'CUBE',&
         'Signal cube',&
         strg_id,&
         code_arg_optional,&
         [flag_cube],&
         code_read,&
         code_access_speset,&
         comm%cube,&
         error)
    if (error) return
    call incube%register(&
         'NOISE',&
         'Noise levels',&
         strg_id,&
         code_arg_optional,&
         [flag_noise],&
         code_read,&
         code_access_speset,&
         comm%noise,&
         error)
    if (error) return
    !
    call comm%range%register('RANGE',&
         'Define the velocity range(s) over which to compute moments',&
         range_is_multiple,error)
    if (error) return
    !
    call comm%win%fully_register(&
         'WINDOWS','[windid]',&
         'Use a window set per spectrum',strg_id,&
         'WINDOWS','Spectral windows',&
         [flag_window],&
         code_arg_optional,&
         code_read,&
         code_access_speset,&
         error)
    if (error) return
    !
    ! Products
    call comm%moments%register(error)
    if (error)  return
  end subroutine cubemain_moments_comm_register
  !
  subroutine cubemain_moments_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! MOMENTS [cubeid [noiseid]]
    ! /RANGE vfirst vlast
    ! /WINDOWS windowid 
    !----------------------------------------------------------------------
    class(moments_comm_t), intent(inout) :: comm
    character(len=*),      intent(in)    :: line
    type(moments_user_t),  intent(out)   :: user
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='MOMENTS>COMM>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,comm%comm,user%cubeids,error)
    if (error) return
    call comm%range%parse(line,user%dorange,user%range,error)
    if (error) return
    call comm%win%parse(line,user%win,error)
    if (error) return
  end subroutine cubemain_moments_comm_parse
  !
  subroutine cubemain_moments_comm_main(comm,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(moments_comm_t), intent(in)    :: comm
    type(moments_user_t),  intent(inout) :: user
    logical,               intent(inout) :: error
    !
    type(moments_prog_t) :: prog
    character(len=*), parameter :: rname='MOMENTS>COMM>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(comm,prog,error)
    if (error) return
    call prog%header(comm,error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubemain_moments_comm_main
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_moments_user_toprog(user,comm,prog,error)
    use cubetools_shape_types
    use cubetools_header_methods
    use cubetools_consistency_methods
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(moments_user_t), intent(in)    :: user
    type(moments_comm_t),  intent(in)    :: comm
    type(moments_prog_t),  intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(shape_t) :: n
    logical :: conspb
    integer(kind=wind_k) :: iw
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='MOMENTS>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    conspb = .false. ! For consistency checks
    call cubeadm_get_header(comm%cube,user%cubeids,prog%cube,error)
    if (error) return
    call cubeadm_get_header(comm%noise,user%cubeids,prog%noise,error)
    if (error) return
    call cubetools_consistency_signal_noise(&
         'Cube',prog%cube%head,&
         'Noise',prog%noise%head,conspb,&
         error)
    if (error) return
    call user%win%toprog(comm%win,prog%locwin,error)
    if (error) return
    if (prog%locwin%do) then
       ! User requests to use a windowing file
       call cubetools_consistency_spatial(&
            'Cube',prog%cube%head,&
            'Window',prog%locwin%cube%head,&
            conspb,error)
       if (error) return
       call cubetools_header_get_array_shape(prog%locwin%cube%head,n,error)
       if (error) return
       prog%nw = n%c
       if (mod(prog%nw,2).ne.0) then
          call cubemain_message(seve%e,rname,'Odd number of window edges!')
          error = .true.
          return
       else
          prog%nw = prog%nw/2
       endif
       !
       call cubetools_header_get_array_shape(prog%cube%head,n,error)
       if (error) return
       prog%nc = n%c
    else
       ! Try to use a global window
       ! When the user did not define any range, it defaults to the full
       ! spectrum range => 1 window
       ! *** JP: to be checked...
       call comm%range%user2prog(prog%cube,user%range,prog%glowin,error)
       if (error) return
       prog%nw = prog%glowin%n
       !
       prog%nc = 0
       do iw=1,prog%nw
          if (prog%nc.lt.prog%glowin%val(iw)%nc) prog%nc = prog%glowin%val(iw)%nc
       enddo ! iw
    endif
    if (cubetools_consistency_failed(rname,conspb,error)) return
    ! Another sanity check
    if (prog%nw.le.0) then
       call cubemain_message(seve%e,rname,'Negative or zero number of windows')
       error = .true.
       return
    endif
    ! User feedback
    write (mess,'(a,i0)') 'Maximum number of spectral moments: ',prog%nw
    call cubemain_message(seve%i,rname,mess)
  end subroutine cubemain_moments_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_moments_prog_header(prog,comm,error)
    use cubetools_consistency_methods
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(moments_prog_t), intent(inout) :: prog
    type(moments_comm_t),  intent(in)    :: comm
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='MOMENTS>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call prog%moments%header(comm%moments,prog%cube,prog%nw,error)
    if (error) return
  end subroutine cubemain_moments_prog_header
  !
  subroutine cubemain_moments_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='MOMENTS>PROG>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP PARALLEL DEFAULT(none) SHARED(prog,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))   
       if (error) exit
       !$OMP TASK SHARED(prog,error) FIRSTPRIVATE(iter)
       if (.not.error) call prog%loop(iter,error)
       !$OMP END TASK
    enddo ! iter
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_moments_prog_data
  !
  subroutine cubemain_moments_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_prog_t),    intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='MOMENTS>PROG>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (prog%locwin%do) then
       call prog%locwin_loop(iter,error)
       if (error) return
    else
       call prog%glowin_loop(iter,error)
       if (error) return
    endif
  end subroutine cubemain_moments_prog_loop  
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_moments_prog_locwin_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubemain_spectrum_real
    use cubemain_spectrum_blanking
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_prog_t), target, intent(inout) :: prog
    type(cubeadm_iterator_t),      intent(inout) :: iter
    logical,                       intent(inout) :: error
    !
    type(spectrum_t) :: spec,good,noise,win
    type(moments_specset_t) :: specset
    integer(kind=chan_k), parameter :: one=1
    character(len=*), parameter :: rname='MOMENTS>PROG>LOCWIN>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call spec%reassociate_and_init(prog%cube,iter,error)
    if (error) return
    call good%reallocate('good',prog%nc,iter,error)
    if (error) return
    call noise%reallocate('noise',one,iter,error)
    if (error) return
    call win%reallocate('win',int(2*prog%nw,kind=chan_k),iter,error)
    if (error) return
    call specset%reallocate(prog%nw,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
       call prog%locwin_act(iter%ie,spec,good,noise,win,specset,error)
       if (error) return
    enddo ! ie
  end subroutine cubemain_moments_prog_locwin_loop
  !
  subroutine cubemain_moments_prog_locwin_act(prog,ie,spec,good,noise,win,specset,error)
    use cubemain_spectrum_real
    use cubetopology_tool
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_prog_t),   intent(inout) :: prog
    integer(kind=entr_k),    intent(in)    :: ie
    type(spectrum_t),        intent(inout) :: spec
    type(spectrum_t),        intent(inout) :: good
    type(spectrum_t),        intent(inout) :: noise
    type(spectrum_t),        intent(inout) :: win
    type(moments_specset_t), intent(inout) :: specset
    logical,                 intent(inout) :: error
    !
    integer(kind=wind_k) :: iw
    integer(kind=chan_k) :: ichan(2)
    real(kind=coor_k) :: vrange(2)
    character(len=*), parameter :: rname='MOMENTS>PROG>LOCWIN>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call spec%get(prog%cube,ie,error)
    if (error) return
    call noise%get(prog%noise,ie,error)
    if (error) return
    call win%get(prog%locwin%cube,ie,error)
    if (error) return
    do iw=1,prog%nw
       if (cubemain_window_blank(win,iw)) then
          call specset%null(iw,error)
          if (error) return
          cycle
       endif
       vrange(:) = win%t(2*iw-1:2*iw)
       call cubetopology_tool_vrange2crange(prog%cube,vrange,ichan,error)
       if (error) return
       call specset%compute(spec,ichan(1),ichan(2),noise%t(1),good,iw,error)
       if (error) return
    enddo ! iw
    call specset%put(prog%moments,ie,error)
    if (error) return
  end subroutine cubemain_moments_prog_locwin_act
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_moments_prog_glowin_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_prog_t),    intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(spectrum_t) :: noise,spec,good
    type(moments_specset_t) :: specset
    integer(kind=chan_k), parameter :: one=1
    character(len=*), parameter :: rname='MOMENTS>PROG>GLOWIN>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call spec%reassociate_and_init(prog%cube,iter,error)
    if (error) return
    call good%reallocate('good',prog%nc,iter,error)
    if (error) return
    call noise%reallocate('noise',one,iter,error)
    if (error) return
    call specset%reallocate(prog%nw,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
       call prog%glowin_act(iter%ie,spec,good,noise,prog%glowin,specset,error)
       if (error) return
    enddo ! ie
  end subroutine cubemain_moments_prog_glowin_loop
  !
  subroutine cubemain_moments_prog_glowin_act(prog,ie,spec,good,noise,win,specset,error)
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(moments_prog_t),   intent(inout) :: prog
    integer(kind=entr_k),    intent(in)    :: ie
    type(spectrum_t),        intent(inout) :: spec
    type(spectrum_t),        intent(inout) :: good
    type(spectrum_t),        intent(inout) :: noise
    type(window_array_t),    intent(in)    :: win
    type(moments_specset_t), intent(inout) :: specset
    logical,                 intent(inout) :: error
    !
    integer(kind=wind_k) :: iw
    integer(kind=chan_k) :: sfirst,slast
    character(len=*), parameter :: rname='MOMENTS>PROG>GLOWIN>ACT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call spec%get(prog%cube,ie,error)
    if (error) return
    call noise%get(prog%noise,ie,error)
    if (error) return
    do iw=1,prog%nw
       if (win%val(iw)%nc.le.0) then
          call specset%null(iw,error)
          if (error) return
          cycle
       endif
       sfirst = win%val(iw)%o(1)
       slast  = win%val(iw)%o(2)
       call specset%compute(spec,sfirst,slast,noise%t(1),good,iw,error)
       if (error) return
    enddo ! iw
    call specset%put(prog%moments,ie,error)
    if (error) return
  end subroutine cubemain_moments_prog_glowin_act
end module cubemain_moments
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
