!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubego_topology
  use cubetools_parameters
  use cubetools_structure
  use cubetools_switch_types
  use cube_types
  use cubeadm_cubeid_types
  use cubetopology_cuberegion_types
  use cubetopology_speline_types
  use cubetopology_spevsys_types
  use cubetopology_spasamp_types
  use cubeset_spatial
  use cubeset_spectral
  use cubego_messaging
  use cubego_extrema_types
  !
  public :: topology
  private
  !
  type :: topology_comm_t
     type(option_t),     pointer :: comm
     type(cubeid_arg_t), pointer :: cube
     type(option_t),     pointer :: list
     type(switch_comm_t)         :: truncate
   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
  !
  type topology_user_t
     logical             :: dolist
     type(cubeid_user_t) :: incube
     type(switch_user_t) :: truncate
   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(cuberegion_prog_t) :: region
     type(extrema_prog_t)    :: extrema
     type(switch_prog_t)     :: truncate
   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], &
         code_read, &
         code_access_subset, &
         topology%cube, &
         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
    !
    call topology%truncate%register('TRUNCATE',  &
         'Truncate ranges at pixels/channels 1 and N',&
         'ON',error)
    if (error) return
  end subroutine cubego_topology_register
  !
  subroutine cubego_topology_parse(topology,line,user,error)
    !-------------------------------------------------------------------
    ! TOPOLOGY cubeid [/LIST] [/TRUNCATE ON|OFF]
    !-------------------------------------------------------------------
    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
    call topology%truncate%parse(line,user%truncate,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(topology,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,comm,prog,error)
    use cubeadm_get
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(topology_user_t), intent(in)    :: user
    type(topology_comm_t),  intent(in)    :: comm
    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_get_header(topology%cube,user%incube,prog%cube,error)
    if (error) return
    prog%dolist = user%dolist
    !
    call prog%truncate%init(comm%truncate,error)
    if (error)  return
    call user%truncate%toprog(comm%truncate,prog%truncate,error)
    if (error)  return
    !
    call cubego_topology_user_toprog_region(prog,prog%region,error)
    if (error)  return
  end subroutine cubego_topology_user_toprog
  !
  subroutine cubego_topology_user_toprog_region(prog,region,error)
    use cubetopology_sperange_types
    use cubetopology_sparange_types
    !-------------------------------------------------------------------
    ! Duplication of part of cubetopology_cuberegion_user_toprog because:
    ! 1. This code fills the cuberegion_prog_t but the user* types
    !    are not cuberegion_user_t.
    ! 2. The user may want to have a larger topology than the cube can
    !    provide. It's his responsability to intersect when
    !    needed. Nevertheless the command will also compute the minimum and
    !    maximum value of the subcube that intersect the user request and
    !    the actual cube.
    !-------------------------------------------------------------------
    class(topology_prog_t),  intent(inout) :: prog
    type(cuberegion_prog_t), intent(out)   :: region
    logical,                 intent(inout) :: error
    !
    integer(kind=code_k) :: code_sperange,code_sparange
    character(len=*), parameter :: rname='TOPOLOGY>USER>TOPROG>REGION'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    if (prog%truncate%enabled) then
      code_sperange = code_sperange_truncated
      code_sparange = code_sparange_truncated
    else
      code_sperange = code_sperange_full
      code_sparange = code_sparange_full
    endif
    !
    ! From user to prog ranges
    call userspe%toprog(prog%cube,code_sperange,prog%freq,prog%vsys,region%zrange,error)
    if (error) return
    call userspa%toprog(prog%cube,code_sparange,region%xrange,region%yrange,error)
    if (error) return
    !
    ! Ensure that the range will be inside the axis range
    call region%xrange%intersect_axis(error)
    if (error) return
    call region%yrange%intersect_axis(error)
    if (error) return
    call region%zrange%intersect_axis(error)
    if (error) return
    ! Then compute the associated firstlaststride to ensure that we will compute the
    ! minimum and maximum value inside the part of the cube that intersects the user
    ! defined region
    call region%xrange%to_pixe_k(region%ix%first,region%ix%last,region%ix%stride,error)
    if (error) return
    call region%yrange%to_pixe_k(region%iy%first,region%iy%last,region%iy%stride,error)
    if (error) return
    call region%zrange%to_chan_k(region%iz%first,region%iz%last,region%iz%stride,error)
    if (error) return
    !
    ! From user to prog ranges again to avoid the previous intersection
    call userspe%toprog(prog%cube,code_sperange,prog%freq,prog%vsys,region%zrange,error)
    if (error) return
    call userspa%toprog(prog%cube,code_sparange,region%xrange,region%yrange,error)
    if (error) return
  end subroutine cubego_topology_user_toprog_region
  !
  !----------------------------------------------------------------------
  !
  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 prog%extrema%get(prog%cube,prog%region,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_user,error)
    if (error) return
    call prog%region%xrange%def_substruct('x',struct,error)
    if (error) return
    call prog%region%yrange%def_substruct('y',struct,error)
    if (error) return
    call prog%region%zrange%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 prog%region%list(error)
    if (error) return
    call prog%region%list_size_center(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
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
