!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_lists
  use cube_types
  use cubeadm_get
  use cubemain_messaging
  !
  ! *** JP The naming convention of the methods is not completely clear to me ;-).
  !
  public :: entry_t,cublist_t
  public :: cubemain_cublist_register,cubemain_cublist_parse
  public :: cubemain_cublist_register_weights,cubemain_cublist_parse_weights
  public :: cubemain_cublist_get_headers
  public :: cubemain_cublist_get_entry_header,cubemain_cublist_clone_entry_header
  public :: cubemain_cublist_copy
  private
  !
  type entry_t
     character(len=file_l) :: name              ! Name of the cube
     type(cube_t),pointer  :: cube              ! Data cube
     type(cube_t),pointer  :: noise             ! Noise cube
     real(kind=sign_k)     :: weig    = 1.0     ! Global weight for entry if noise is not used
     logical               :: donoise = .false. ! Use noise for weighting
     logical               :: loaded  = .false. ! Was the entry loaded at least once?
  end type entry_t
  !
  type cublist_t
     type(entry_t), allocatable :: entries(:)   ! Entries of the list
     integer(kind=4)            :: n=0          ! Number of entries of the list
     integer(kind=code_k)       :: access       ! Access of the majority of the list
  end type cublist_t
  !
contains
  !
  subroutine cubemain_cublist_register(name,abstract,help,opt,error)
    use cubetools_structure
    use cubedag_allflags
    use cubeadm_cubeid_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),       intent(in)    :: name
    character(len=*),       intent(in)    :: abstract
    character(len=*),       intent(in)    :: help
    type(option_t),pointer, intent(out)   :: opt
    logical,                intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    character(len=*), parameter :: rname='CUBLIST>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'cub1 cub2 [... [cubn]]',&
         abstract,&
         help,&
         opt,error)
    if (error) return
    call cubearg%register( &
         'cub1', &
         'First cube',  &
         strg_id,&
         mandatory,  &
         [flag_cube], &
         error)
    if (error) return
    call cubearg%register( &
         'cub2', &
         'Second cube',  &
         strg_id,&
         mandatory,  &
         [flag_cube], &
         error)
    if (error) return
    call cubearg%register( &
         'cubn', &
         'N-eth cube',  &
         strg_id,&
         .not.mandatory,  &
         [flag_cube], &
         error)
    if (error) return
  end subroutine cubemain_cublist_register
  !
  subroutine cubemain_cublist_parse(line,opt,cublist,error)
    use cubetools_structure
    !----------------------------------------------------------------------
    ! parses a list of cubes cub1 cub2 ... cubn
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    type(option_t),   intent(in)    :: opt
    type(cublist_t),  intent(out)   :: cublist
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: ncub,icub
    character(len=*), parameter :: rname='CUBLIST>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ncub = opt%getnarg()
    if (ncub.le.1) then
       call cubemain_message(seve%e,rname,'Need at least 2 cubes for a cube list')
       error = .true.
       return
    endif
    !
    call cubemain_cublist_reallocate(ncub,cublist,error)
    if(error) return
    !
    do icub=1,ncub
       call cubetools_getarg(line,opt,icub,cublist%entries(icub)%name,mandatory,error)
       if (error) return
    enddo
  end subroutine cubemain_cublist_parse
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_cublist_register_weights(name,abstract,opt,error)
    use cubetools_structure
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),       intent(in)    :: name
    character(len=*),       intent(in)    :: abstract
    type(option_t),pointer, intent(out)   :: opt
    logical,                intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='CUBLIST>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'EQUAL|w1 ... wn',&
         abstract,&
         'There are currently two possible weighting schemes for the&
         & averaging: Equal weighting or a specific weight for each&
         & cube',&
         opt,error)
    if (error) return
    !
    call stdarg%register( &
         'Scheme|w1',  &
         'Wavelet degree', &
         strg_id,&
         mandatory, &
         error)
    if (error) return
    call stdarg%register( &
         'Scheme|wn',  &
         'Wavelet degree', &
         strg_id,&
         .not.mandatory, &
         error)
    if (error) return
  end subroutine cubemain_cublist_register_weights
  !
  subroutine cubemain_cublist_parse_weights(line,opt,cublist,donoise,error)
    use cubetools_structure
    use cubetools_disambiguate
    !----------------------------------------------------------------------
    ! parses weights for a cublist, if option is not given defaults to
    ! noise
    ! ----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    type(option_t),   intent(in)    :: opt
    type(cublist_t),  intent(inout) :: cublist
    logical,          intent(out)   :: donoise
    logical,          intent(inout) :: error
    !
    ! integer, parameter :: nweights=2
    integer, parameter :: nweights=1
    integer(kind=4) :: narg,icub,pos
    logical :: doweight
    character(len=argu_l)  :: weights(nweights),desamb,typed
    character(len=*), parameter :: rname='CUBLIST>PARSE>WEIGHTS'
    !
    ! data weights/'EQUAL','NOISE'/
    data weights/'EQUAL'/
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    narg = opt%getnarg()
    !
    call opt%present(line,doweight,error)
    if (error) return
    if (doweight) then
       if (narg.eq.cublist%n) then ! One weight per cube
          do icub=1,narg
             call cubetools_getarg(line,opt,icub,cublist%entries(icub)%weig,mandatory,error)
             if (error) return
          enddo
          cublist%entries(:)%donoise = .false.
          donoise = .false.
       else if (narg.eq.1) then ! A keyword
          call cubetools_getarg(line,opt,1,typed,mandatory,error)
          if (error)  return
          call cubetools_disambiguate_strict(typed,weights,pos,desamb,error)
          if (error) return
          select case(desamb)
          case('NOISE')
             donoise = .true.
             cublist%entries(:)%donoise = .true.
          case('EQUAL')
             cublist%entries(:)%weig = 1.0
             cublist%entries(:)%donoise = .false.
          case default
             call cubemain_message(seve%e,rname,'Unknown weighting scheme '//trim(desamb))
             error = .true.
             return
          end select
       else ! an user Error
          call cubemain_message(seve%e,rname,'Weights must be given one per cube, or as a keyword')
          error = .true.
          return
       endif
    else
       ! VVV While noise weighting is not solved, default will be
       ! equal noise.
       ! donoise = .true.
       ! cublist%entries(:)%donoise = .true.
       donoise = .false.
       cublist%entries(:)%donoise = .false.
       cublist%entries(:)%weig = 1.0
    endif
  end subroutine cubemain_cublist_parse_weights
  !
  !------------------------------------------------------------------------
  !
  function cubemain_cublist_loaded(cublist)
    logical :: cubemain_cublist_loaded
    type(cublist_t), intent(in) :: cublist
    !
    cubemain_cublist_loaded = .false.
    if (cublist%n.le.1) then
       cubemain_cublist_loaded = .false.
    else
       cubemain_cublist_loaded = all(cublist%entries(:)%loaded)
    endif
  end function cubemain_cublist_loaded
  !
  subroutine cubemain_cublist_reallocate(n,cublist,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=4), intent(in)    :: n
    type(cublist_t), intent(inout) :: cublist
    logical,         intent(inout) :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='CUBLIST>REALLOCATE'
    !
    if (n.le.1) then
       call cubemain_message(seve%e,rname,'Cube list must have at least 2 entries')
       error = .true.
       return
    end if
    !
    if (allocated(cublist%entries)) then
       if (cubemain_cublist_loaded(cublist)) then
          ! VVV Is this True now? Finalization etc, is now managed by the dag
          call cubemain_message(seve%e,rname,'Cannot reallocate list of loaded cubes, must finalize first')
          error = .true.
          return
       else
          deallocate(cublist%entries)
       endif
    endif
    allocate(cublist%entries(n),stat=ier)
    if (failed_allocate(rname,'Cube list',ier,error)) return
    !
    cublist%n = n
  end subroutine cubemain_cublist_reallocate
  !
  subroutine cubemain_cublist_copy(cublist1,cublist2,error)
    !----------------------------------------------------------------------
    ! Copies cublist1 into cublist2
    !----------------------------------------------------------------------
    type(cublist_t), intent(in)    :: cublist1
    type(cublist_t), intent(out)   :: cublist2
    logical,         intent(inout) :: error
    !
    character(len=*), parameter :: rname='CUBLIST>COPY'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (cubemain_cublist_loaded(cublist1).or.cubemain_cublist_loaded(cublist2)) then
       call cubemain_message(seve%e,rname,'Cannot copy between loaded cublists')
       error = .true.
       return
    else
       call cubemain_cublist_reallocate(cublist1%n,cublist2,error)
       if (error) return
       cublist2%entries(:)%name    = cublist1%entries(:)%name
       cublist2%entries(:)%weig    = cublist1%entries(:)%weig
       cublist2%entries(:)%donoise = cublist1%entries(:)%donoise
       cublist2%entries(:)%loaded = cublist1%entries(:)%loaded
    endif
  end subroutine cubemain_cublist_copy
  !
  subroutine cubemain_cublist_get_entry_header(access,entry,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    ! Gets the header of all cubes in the cube list
    !----------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: access  ! code_access_*
    type(entry_t),        intent(inout) :: entry
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CUBLIST>GET>ENTRY>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (entry%loaded) then
       call cubeadm_access_header(entry%cube,access,code_read,error)
       if (error) return
       if (entry%donoise) then
          call cubeadm_access_header(entry%noise,access,code_read,error)
          if (error) return
       endif
    else
       call cubeadm_get_cheader(trim(entry%name),[flag_cube],access,code_read,entry%cube,error)
       if (error) return
       if (entry%donoise) then
          call cubeadm_get_cheader(trim(entry%name),[flag_noise],access,code_read,entry%noise,error)
          if (error) return
       endif
    endif
    entry%loaded = .true.
  end subroutine cubemain_cublist_get_entry_header
  !
  subroutine cubemain_cublist_clone_entry_header(flag,entry,output,error)
    use cubedag_allflags
    use cubeadm_clone
    !----------------------------------------------------------------------
    ! clone an entry into another
    !----------------------------------------------------------------------
    type(flag_t),  intent(in)    :: flag
    type(entry_t), intent(inout) :: entry
    type(entry_t), intent(inout) :: output
    logical,       intent(inout) :: error
    !
    character(len=*), parameter :: rname='CUBLIST>CLONE>ENTRY>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (output%loaded) then
       call cubemain_message(seve%e,rname,'Output entry already loaded, finalize first')
       error = .true.
       return
    endif
    call cubeadm_clone_header(entry%cube,flag,output%cube,error)
    if (error) return
    if (entry%donoise) then
       output%donoise = .true.
       call cubeadm_clone_header(entry%noise,[flag,flag_noise],output%noise,error)
       if (error) return
    endif
    output%loaded = .true.
  end subroutine cubemain_cublist_clone_entry_header
  !
  subroutine cubemain_cublist_get_headers(access,cublist,error)
    !----------------------------------------------------------------------
    ! Gets the header of all cubes in the cube list
    !----------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: access
    type(cublist_t),      intent(inout) :: cublist
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: icub,nspe,nima
    character(len=*), parameter :: rname='CUBLIST>GET>HEADERS'
    !
    nspe = 0
    nima = 0
    do icub=1,cublist%n
       call cubemain_cublist_get_entry_header(access,cublist%entries(icub),error)
       if (error) return
       if (access.eq.code_access_imaset_or_speset) then
          if (cublist%entries(icub)%cube%order().eq.code_cube_imaset) nima = nima+1
          if (cublist%entries(icub)%cube%order().eq.code_cube_speset) nspe = nspe+1
       endif
    enddo
    !
    select case(access)
    case(code_access_imaset)
       cublist%access = code_cube_imaset
    case(code_access_speset)
       cublist%access = code_cube_speset
    case(code_access_imaset_or_speset)
       if (nima.gt.nspe) then
          cublist%access = code_cube_imaset
       else if (nspe.gt.nima) then
          cublist%access = code_cube_speset
       else
          ! VVV this may be the more sensible possibility but require
          ! buttons be turned elsewhere
          ! cublist%access = code_access_imaset_or_speset
          cublist%access = code_cube_speset
       endif
    case default
       call cubemain_message(seve%e,rname,'Unknown acess code')
       error = .true.
       return
    end select
  end subroutine cubemain_cublist_get_headers
end module cubemain_lists
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
