!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_window
  use cubetools_parameters
  use cube_types
  use cubetools_structure
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubemain_messaging
  use cubemain_windowing
  use cubemain_range
  !
  public :: window
  private
  !
  type :: window_comm_t
     type(option_t),     pointer :: comm
     type(cubeid_arg_t), pointer :: cube
     type(option_t),     pointer :: niter
     type(range_opt_t)           :: range
     type(cube_prod_t),  pointer :: wlocal
   contains
     procedure, public  :: register => cubemain_window_register
     procedure, private :: parse    => cubemain_window_parse
     procedure, private :: main     => cubemain_window_main
  end type window_comm_t
  type(window_comm_t) :: window
  !
  type window_user_t
     type(cubeid_user_t)   :: cubeids
     character(len=argu_l) :: niter             ! Number of iterations
     type(range_array_t)   :: range             ! Spectral range to be used
     logical               :: dorange = .false. ! do a range
   contains
     procedure, private :: toprog => cubemain_window_user_toprog
  end type window_user_t
  !
  type window_prog_t
     integer(kind=wind_k)  :: niter = 1  ! Number of iterations
     type(window_array_t)  :: wglobal    ! Initial window guess for all spectra
     type(cube_t), pointer :: cube       ! Input cube
     type(cube_t), pointer :: wlocal     ! Output window per spectrum
   contains
     procedure, private :: header => cubemain_window_prog_header
     procedure, private :: data   => cubemain_window_prog_data
     procedure, private :: loop   => cubemain_window_prog_loop
     procedure, private :: act    => cubemain_window_prog_act
  end type window_prog_t
  !
contains
  !
  subroutine cubemain_window_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(window_user_t) :: user
    type(window_prog_t) :: prog
    character(len=*), parameter :: rname='WINDOW>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call window%parse(line,user,error)
    if (error) return
    call window%main(user,prog,error)
    if (error) continue
  end subroutine cubemain_window_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_window_register(window,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(window_comm_t), intent(inout) :: window
    logical,              intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(cube_prod_t) :: oucube
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='WINDOW>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'WINDOW','[signalid]',&
         'Find the signal windows of each spectrum of a cube',&
         'WINDOW finds signal windows for each spectrum in a cube.'//strg_bl//&
         'Behavior:'//strg_cr//&
         '- A window is a contiguous channel interval that reaches the&
         & zero level from the spectrum maximum.'//strg_cr//&
         '- /RANGE constrains where windows are searched in each&
         & spectrum.'//strg_cr//&
         '- /NITER controls how many windows are found per input&
         & global range.'//strg_bl//&
         'Examples:'//strg_cr//&
         'CUBE> WINDOW mycube /RANGE -20 20 km/s'//strg_cr//&
         'CUBE> WINDOW mycube /RANGE -20 20 km/s /NITER 2.',&
         cubemain_window_command,&
         window%comm,error)
    if (error) return
    call cubearg%register(&
         'SIGNALID',&
         'Signal cube identifier',&
         '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_speset,&
         window%cube,&
         error)
    if (error) return
    !
    call window%range%register(&
         'RANGE',&
         'Define the velocity range(s) containing signal',&
         range_is_multiple,error)
    if (error) return
    !
    call cubetools_register_option(&
         'NITER','number',&
         'Set the number of windows to be found',&
         strg_emp,&
         window%niter,error)
    if (error) return
    call stdarg%register(&
         'niter',&
         'Number of windows',&
         strg_emp,&
         code_arg_mandatory,&
         error)
    if (error) return
    !
    ! Product
    call oucube%register(&
         'WINDOW',&
         'Cube of windows',&
         strg_emp,&
         [flag_window],&
         window%wlocal,&
         error)
    if (error) return
  end subroutine cubemain_window_register
  !
  subroutine cubemain_window_parse(window,line,user,error)
    !----------------------------------------------------------------------
    ! WINDOW [cubeid]
    ! /RANGE v11 v12 [... [vn1 vn2]] [unit]
    ! /NITER niter
    !----------------------------------------------------------------------
    class(window_comm_t), intent(inout) :: window
    character(len=*),     intent(in)    :: line
    type(window_user_t),  intent(out)   :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='WINDOW>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,window%comm,user%cubeids,error)
    if (error) return
    call window%range%parse(line,user%dorange,user%range,error)
    if (error) return
    call cubemain_window_parse_nwind(line,window%niter,user%niter,error)
    if (error) return
  end subroutine cubemain_window_parse
  !
  subroutine cubemain_window_parse_nwind(line,opt,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    type(option_t),   intent(in)    :: opt
    character(len=*), intent(out)   :: user
    logical,          intent(inout) :: error
    !
    logical :: present
    integer(kind=4), parameter :: iarg=1
    character(len=*), parameter :: rname='WINDOW>PARSE>NWIND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call opt%present(line,present,error)
    if (error) return
    if (present) then
       call cubetools_getarg(line,opt,iarg,user,mandatory,error)
       if (error) return
    else
       user = strg_star
    endif
  end subroutine cubemain_window_parse_nwind
  !
  subroutine cubemain_window_main(comm,user,prog,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(window_comm_t), intent(in)    :: comm
    type(window_user_t),  intent(inout) :: user
    type(window_prog_t),  intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='WINDOW>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(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_window_main
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_window_user_toprog(user,prog,error)
    use cubetools_user2prog
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(window_user_t), intent(inout) :: user
    type(window_prog_t),  intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    integer(kind=wind_k) :: default
    character(len=*), parameter :: rname='WINDOW>USER>TOPROG'
    !    
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_get_header(window%cube,user%cubeids,&
         prog%cube,error)
    if (error) return
    call window%range%user2prog(prog%cube,user%range,prog%wglobal,error)
    if (error) return
    default = 1
    call cubetools_user2prog_resolve_star(user%niter,default,prog%niter,error)
    if (error) return
  end subroutine cubemain_window_user_toprog
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_window_prog_header(prog,comm,error)
    use cubeadm_clone
    use cubetools_axis_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(window_prog_t), intent(inout) :: prog
    type(window_comm_t),  intent(in)    :: comm
    logical,              intent(inout) :: error
    !
    type(axis_t) :: axis
    character(len=*), parameter :: rname='WINDOW>PROG>HEADER'
    !    
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(comm%wlocal,prog%cube,prog%wlocal,error)
    if (error) return
    call cubetools_header_get_axis_head_c(prog%wlocal%head,axis,error)
    if (error) return
    axis%name = 'SpecWind'
    axis%n = 2*(prog%wglobal%n*prog%niter)
    axis%ref = 0d0
    axis%val = 0d0
    axis%inc = 1d0
    call cubetools_header_update_axset_c(axis,prog%wlocal%head,error)
    if (error) return
    call cubetools_header_put_nchan(axis%n,prog%wlocal%head,error)
    if (error) return
  end subroutine cubemain_window_prog_header
  !
  subroutine cubemain_window_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(window_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='WINDOW>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 ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
    !
  end subroutine cubemain_window_prog_data
  
  subroutine cubemain_window_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(window_prog_t),     intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(spectrum_t) :: spec,good,sorted,wlocal
    integer(kind=wind_k) :: iw
    integer(kind=chan_k) :: nchan
    character(len=*), parameter :: rname='WINDOW>PROG>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    nchan = 0
    do iw=1,prog%wglobal%n
       if (nchan.lt.prog%wglobal%val(iw)%nc) nchan = prog%wglobal%val(iw)%nc
    enddo
    call good%reallocate('good',nchan,iter,error)
    if (error) return
    call sorted%reallocate('sorted',nchan,iter,error)
    if (error) return
    call wlocal%reallocate('wlocal',prog%wlocal%head%arr%n%c,iter,error)
    if (error) return
    call spec%reallocate_and_init(prog%cube,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
      call prog%act(iter%ie,spec,good,sorted,wlocal,error)
      if (error) return
    enddo
  end subroutine cubemain_window_prog_loop
  !
  subroutine cubemain_window_prog_act(prog,ie,spec,good,sorted,wlocal,error)
    use cubetools_nan
    use cubemain_spectrum_real
    use cubemain_spectrum_blanking
    use cubemain_spectrum_moment_tool
    use cubemain_spectrum_operations
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(window_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) :: sorted
    type(spectrum_t),     intent(inout) :: wlocal
    logical,              intent(inout) :: error
    !
    integer(kind=wind_k) :: iw
    integer(kind=wind_k) :: jw,iiter
    integer(kind=chan_k) :: first,last
    type(window_scalar_t) :: wfound
    type(spectrum_tpeak_t) :: tpeak
    type(spectrum_t) :: line
    character(len=*), parameter :: rname='WINDOW>PROG>ACT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call spec%get(prog%cube,ie,error)
    if (error) return
    jw = 1
    do iw=1,prog%wglobal%n
       if (prog%wglobal%val(iw)%nc.le.0) cycle
       first = prog%wglobal%val(iw)%o(1)
       last  = prog%wglobal%val(iw)%o(2)
       call line%point_to(spec,first,last,1.0,error)
       if (error) return
       do iiter=1,prog%niter
          call cubemain_spectrum_unblank(line,good,error)
          if (error) return
          if (good%n.gt.0) then
             call tpeak%compute(good,error)
             if (error) return
             call cubemain_spectrum_sort(tpeak%ic,good,sorted,error)
             if (error) return
             call cubemain_spectrum_wind(sorted,wfound,error)
             if (error) return
             wlocal%t(jw)   = sorted%v(wfound%o(1))
             wlocal%t(jw+1) = sorted%v(wfound%o(2))
             line%t(wfound%o(1)-first+1:wfound%o(2)-first+1) = gr4nan
             jw = jw+2
          else
             wlocal%t(jw:jw+1) = gr4nan
          endif
       enddo ! iiter
    enddo ! iw
    call wlocal%put(prog%wlocal,ie,error)
    if (error) return
  end subroutine cubemain_window_prog_act
end module cubemain_window
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
