!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubego_topology
  use cubetools_structure
  use cube_types
  use cubeadm_cubeid_types
  use cubemain_speline_types
  use cubemain_spevsys_types
  use cubemain_sperange_types
  use cubemain_sparange_types
  use cubemain_spasamp_types
  use cubemain_extrema_types
  use cubeset_spatial
  use cubeset_spectral
  use cubego_messaging
  !
  public :: cubego_topology_command
  public :: topology,progtopo
  private
  !
  type :: topology_comm_t
     type(option_t), pointer :: comm
     type(option_t), pointer :: list
   contains
     procedure, public  :: register => cubego_topology_register
     procedure, private :: parse    => cubego_topology_parse
     procedure, private :: main     => cubego_topology_main
  end type topology_comm_t
  type(topology_comm_t) :: topology
  !
  integer(kind=4), parameter :: icube = 1
  type topology_user_t
     logical               :: dolist
     type(cubeid_user_t)   :: incube
   contains
     procedure, private :: toprog => cubego_topology_user_toprog
  end type topology_user_t
  !
  type topology_prog_t
     logical               :: dolist
     type(cube_t), pointer :: cube
     type(speline_prog_t)  :: freq
     type(spevsys_prog_t)  :: vsys
     type(sperange_prog_t) :: crange
     type(sparange_prog_t) :: xrange
     type(sparange_prog_t) :: yrange
     type(extrema_desc_t)  :: extrema
   contains
     procedure, private :: compute    => cubego_topology_prog_compute
     procedure, private :: def_struct => cubego_topology_prog_def_struct
     procedure, private :: list       => cubego_topology_prog_list
  end type topology_prog_t
  type(topology_prog_t) :: progtopo
  !
contains
  !
    subroutine cubego_topology_command(line,error)
    !-------------------------------------------------------------------
    ! Support routine for command TOPOLOGY
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(topology_user_t) :: user
    character(len=*), parameter :: rname='TOPOLOGY>COMMAND'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call topology%parse(line,user,error)
    if (error) return
    call topology%main(user,error)
    if (error) return
  end subroutine cubego_topology_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubego_topology_register(topology,error)
    use cubedag_allflags
    !--------------------------------------------------------------------
    ! Support routine for register
    !--------------------------------------------------------------------
    class(topology_comm_t), intent(inout) :: topology
    logical,                intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    character(len=*), parameter :: comm_abstract = &
         'Compute the topology of the region of interest'
    character(len=*), parameter :: comm_help = strg_id
    character(len=*), parameter :: rname='TOPOLOGY>REGISTER'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'TOPOLOGY','[cube]',&
         comm_abstract,&
         comm_help,&
         cubego_topology_command,&
         topology%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Cube for which topology is to be computed',  &
         strg_id,&
         code_arg_optional,  &
         [flag_any], &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'LIST','',&
         'List the topology computed for the current cube',&
         strg_id,&
         topology%list,error)
    if (error) return
  end subroutine cubego_topology_register
  !
  subroutine cubego_topology_parse(topology,line,user,error)
    !-------------------------------------------------------------------
    ! TOPOLOGY cubeid [/LIST]
    !-------------------------------------------------------------------
    class(topology_comm_t), intent(in)    :: topology
    character(len=*),       intent(in)    :: line
    type(topology_user_t),  intent(out)   :: user
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='TOPOLOGY>PARSE'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,topology%comm,user%incube,error)
    if (error) return
    call topology%list%present(line,user%dolist,error)
    if (error) return
  end subroutine cubego_topology_parse
  !
  subroutine cubego_topology_main(topology,user,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(topology_comm_t), intent(in)    :: topology
    type(topology_user_t),  intent(in)    :: user
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='TOPOLOGY>MAIN'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call user%toprog(progtopo,error)
    if (error) return
    call progtopo%compute(error)
    if (error) return
    if (progtopo%dolist) then
       call progtopo%list(error)
       if (error) return
    endif
    ! Need to redefine it each time because it's a copy!
    call progtopo%def_struct('topology',error)
    if (error) return
  end subroutine cubego_topology_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubego_topology_user_toprog(user,prog,error)
    use cubeadm_get
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(topology_user_t), intent(in)    :: user
    type(topology_prog_t),  intent(inout) :: prog
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='TOPOLOGY>USER>TOPROG'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_get_header(topology%comm,&
         icube,user%incube,code_access_imaset_or_speset,&
         code_read,prog%cube,error)
    if (error) return
    prog%dolist = user%dolist
  end subroutine cubego_topology_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubego_topology_prog_compute(prog,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(topology_prog_t), intent(inout) :: prog
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='TOPOLOGY>COMPUTE'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call userspe%toprog(prog%cube,prog%freq,prog%vsys,prog%crange,error)
    if (error) return
    call userspa%toprog(prog%cube,prog%xrange,prog%yrange,error)
    if (error) return
    call prog%extrema%compute(prog%cube,prog%xrange,prog%yrange,prog%crange,error)
    if (error) return
  end subroutine cubego_topology_prog_compute
  !
  subroutine cubego_topology_prog_def_struct(prog,name,error)
    use cubetools_userspace
    use cubetools_userstruct
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(topology_prog_t), intent(in)    :: prog
    character(len=*),       intent(in)    :: name
    logical,                intent(inout) :: error
    !
    type(userstruct_t) :: struct
    character(len=*), parameter :: rname='TOPOLOGY>PROG>DEF>STRUCT'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call struct%create(name,global,overwrite,error)
    if (error) return
    call prog%xrange%def_substruct('x',struct,error)
    if (error) return
    call prog%yrange%def_substruct('y',struct,error)
    if (error) return
    call prog%crange%def_substruct('z',struct,error)
    if (error) return
    call prog%extrema%def_substruct('extrema',struct,error)
    if (error) return
  end subroutine cubego_topology_prog_def_struct
  !
  subroutine cubego_topology_prog_list(prog,error)
    !-------------------------------------------------------------------
    ! List topology variables in a user friendly manner 
    !-------------------------------------------------------------------
    class(topology_prog_t), intent(in)    :: prog
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='TOPOLOGY>PROG>LIST'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call cubego_message(seve%r,rname,blankstr)
    call prog%xrange%list(error)
    if (error) return
    call prog%yrange%list(error)
    if (error) return
    call prog%crange%list(error)
    if (error) return
    call cubego_message(seve%r,rname,blankstr)
    call prog%extrema%list(error)
    if (error) return
  end subroutine cubego_topology_prog_list
end module cubego_topology
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
