!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_observatory_types
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_obstel_types
  use cubetools_consistency_types
  use cubetools_structure
  !
  public :: observatory_t,observatory_user_t,observatory_cons_t,observatory_opt_t
  public :: cubetools_observatory_init,cubetools_observatory_put_and_derive
  public :: cubetools_observatory_final,cubetools_observatory_get
  public :: cubetools_observatory_list
  public :: cubetools_observatory_sicdef,cubetools_observatory_copy
  public :: cubetools_observatory_consistency_check,cubetools_observatory_consistency_print
  public :: cubetools_observatory_consistency_init,cubetools_observatory_consistency_final
  public :: cubetools_observatory_reallocate,cubetools_observatory_add_telescopes
  public :: cubetools_observatory_obs2userstruct
  private
  !
  type observatory_t
     integer(kind=4) :: ntel = 0           ! Number of telescopes present
     type(obstel_t), allocatable :: tel(:) ! Telescope descriptions
  contains
     procedure :: tostr => cubetools_observatory_tostr
     procedure :: write => cubetools_observatory_write
     procedure :: read  => cubetools_observatory_read
  end type observatory_t
  !
  type observatory_opt_t
     type(option_t),      pointer :: opt
   contains
     procedure :: register  => cubetools_observatory_register
     procedure :: parse     => cubetools_observatory_parse
     procedure :: user2prog => cubetools_observatory_user2prog
  end type observatory_opt_t
  !
  type observatory_user_t
     logical               :: do      = .false.    ! Option was present
     integer(kind=4)       :: n       = 0          ! Number of telescopes given
     character(len=argu_l),allocatable :: names(:) ! Telescope names 
  end type observatory_user_t
  !
  type observatory_cons_t
     logical                         :: check=.true.  ! Check the section
     logical                         :: prob =.false. ! Is there a problem
     logical                         :: mess =.true.  ! Output message for this section?
     type(consistency_desc_t)        :: ntel          ! Ntel consistency
     type(obstel_cons_t),allocatable :: tel(:)        ! Allocated to min(obs1%ntel,obs2%ntel)
     integer(kind=4), allocatable    :: found(:)      ! Found in larger section
     integer(kind=4)                 :: n             ! Allocated size
  end type observatory_cons_t
  !
  integer(kind=4), parameter :: key_l=24  ! Note the T26 tab below
  character(len=*), parameter :: form_i4='(A,T26,I11)'
  !
contains
  !
  subroutine cubetools_observatory_init(obs,error)
    !-------------------------------------------------------------------
    ! Just initialize the type, ie, set it intent(out)
    !-------------------------------------------------------------------
    type(observatory_t), intent(out)   :: obs
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_observatory_init
  !
  subroutine cubetools_observatory_put_and_derive(in,ou,error)
    use phys_const
    use image_def
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(observatory_t), intent(in)    :: in
    type(observatory_t), intent(inout) :: ou
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>PUT>AND>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (in%ntel.le.0) then
       call cubetools_message(toolseve%others,rname,'No observatory section defined')
       ou%ntel = 0
    else
       call cubetools_observatory_copy(in,ou,error)
       if (error)  return
    endif
    if (ou%ntel.gt.1) then
       call cubetools_observatory_sort(ou,error)
       if (error) return
    endif
  end subroutine cubetools_observatory_put_and_derive
  !
  subroutine cubetools_observatory_get(in,ou,error)
    use phys_const
    use image_def
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(observatory_t), intent(in)    :: in
    type(observatory_t), intent(inout) :: ou
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>GET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_observatory_copy(in,ou,error)
    if (error)  return
  end subroutine cubetools_observatory_get
  !
  subroutine cubetools_observatory_final(obs,error)
    !-------------------------------------------------------------------
    ! Deallocate and reinitialize the type
    !-------------------------------------------------------------------
    type(observatory_t), intent(inout) :: obs
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (allocated(obs%tel)) deallocate(obs%tel)
    obs%ntel = 0
  end subroutine cubetools_observatory_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_observatory_list(obs,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(observatory_t), intent(in)    :: obs
    logical,             intent(inout) :: error
    !
    integer(kind=argu_k) :: itel
    character(len=*), parameter :: rname='OBSERVATORY>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do itel = 1,obs%ntel
       call cubetools_obstel_list(obs%tel(itel),error)
       if (error) return
    enddo ! itel
  end subroutine cubetools_observatory_list
  !
  subroutine cubetools_observatory_register(obs,abstract,error)
    !----------------------------------------------------------------------
    ! Register a /OBSERVATORY option under a given name, abstract and help
    ! into the option
    !----------------------------------------------------------------------
    class(observatory_opt_t), intent(out)   :: obs
    character(len=*),         intent(in)    :: abstract
    logical,                  intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    !
    character(len=*), parameter :: rname='OBSERVATORY>REGISTER>'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         'OBSERVATORY','[+-]Name1 [... [+-]NameN]',&
         abstract,&
         'Telescopes can be added or removed by using the characters &
         &+ or - in front of their names. If not + or - is added&
         & before the name a + is assumed. e.g.:'//strg_cr//&
         'PUT /OBSERVATORY 30m        ! Adds 30m telescope'//strg_cr//&
         'PUT /OBSERVATORY -ALMA +ACA ! Removes ALMA and adds ACA',&
         obs%opt,error)
    if (error) return
    call stdarg%register( &
         'Name1',  &
         'First observatory to be added or removed', &
         "[+] means add, - means remove",&
         code_arg_mandatory, &
         error)
    if (error) return
    call stdarg%register( &
         'NameN',  &
         'N-eth observatory to be added or removed', &
          "[+] means add, - means remove",&
         code_arg_unlimited, &
         error)
    if (error) return
  end subroutine cubetools_observatory_register
  !
  subroutine cubetools_observatory_parse(obs,line,user,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Parse observatory 
    ! /OBSERVATORY [+-]Name1 ... [+-]NameN
    !----------------------------------------------------------------------
    class(observatory_opt_t), intent(in)    :: obs
    character(len=*),         intent(in)    :: line
    type(observatory_user_t), intent(out)   :: user
    logical,                  intent(inout) :: error
    !
    integer(kind=4) :: itel,nteles,ier
    character(len=*), parameter :: rname='OBSERVATORY>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call obs%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       nteles = obs%opt%getnarg()
       if (nteles.lt.1) then
          call cubetools_message(seve%e,rname,'Must give at least one telescope name')
          error = .true.
          return
       endif
       allocate(user%names(nteles),stat=ier)
       if (failed_allocate(rname,'name array',ier,error)) return
       user%n = nteles
       do itel=1, nteles
          call cubetools_getarg(line,obs%opt,itel,user%names(itel),mandatory,error)
          if (error)  return
       enddo
    endif
  end subroutine cubetools_observatory_parse
  !
  subroutine cubetools_observatory_user2prog(obs,user,prog,error)
    use cubetools_disambiguate
    !----------------------------------------------------------------------
    ! Adds or removes telescopes from the observatory section based on
    ! user inputs
    !----------------------------------------------------------------------
    class(observatory_opt_t), intent(in)    :: obs
    type(observatory_user_t), intent(in)    :: user
    type(observatory_t),      intent(inout) :: prog
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>USER2PROG'
    integer(kind=4) :: itel
    logical :: add
    character(len=tele_l) :: name
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       do itel=1,user%n
          call cubetools_disambiguate_toupper(user%names(itel),name,error)
          if (error) return
          if (name(1:1).eq.'+') then
             add = .true.
             name = name(2:)
          elseif (name(1:1).eq.'-') then
             add = .false.
             name = name(2:)
          else
             add = .true.
          endif
          !
          if (add) then
             call cubetools_observatory_add_telescope(name,prog,error)
          else
             call cubetools_observatory_rm_telescope(name,prog,error)
          endif
          if (error)  return
       enddo
    else
       continue
    endif
    if (prog%ntel.gt.1) then
       call cubetools_observatory_sort(prog,error)
       if (error) return
    endif
  end subroutine cubetools_observatory_user2prog
  !
  subroutine cubetools_observatory_sicdef(name,obs,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),    intent(in)    :: name
    type(observatory_t), intent(in)    :: obs
    logical,             intent(in)    :: readonly
    logical,             intent(inout) :: error
    !
    integer(kind=argu_k) :: itel
    character(len=varn_l) :: tname
    character(len=*), parameter :: rname='OBS>SICDEF'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_inte(trim(name)//'%ntel',obs%ntel,0,0,readonly,error)
    if (error)  return
    do itel = 1,obs%ntel
       write(tname,'(a,i0)') trim(name)//'%tel',itel
       call cubetools_obstel_sicdef(tname,obs%tel(itel),readonly,error)
       if (error)  return
    enddo ! itel    
  end subroutine cubetools_observatory_sicdef
  !
  subroutine cubetools_observatory_obs2userstruct(obs,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Loads observatory section onto a user structure
    !------------------------------------------------------------------------
    type(observatory_t), intent(in)    :: obs
    class(userspace_t),  intent(inout) :: userstruct
    logical,             intent(inout) :: error
    !
    type(userstruct_t) :: telescope
    integer(kind=4) :: itel
    character(len=varn_l) :: name
    character(len=*), parameter :: rname='OBS>OBS2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type (userstruct)
    type is (userstruct_t)
       call userstruct%def(error)
       if (error) return
       !
       call userstruct%set_member('ntel',obs%ntel,error)
       if (error) return
       do itel = 1,obs%ntel
          write(name,'(a,i0)') 'tel',itel
          call userstruct%def_substruct(name,telescope,error)
          if (error) return
          call cubetools_obstel_tel2userstruct(obs%tel(itel),telescope,error)
          if (error) return
       end do
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetools_observatory_obs2userstruct
  !
  subroutine cubetools_observatory_copy(in,ou,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(observatory_t), intent(in)    :: in
    type(observatory_t), intent(inout) :: ou
    logical,             intent(inout) :: error
    !
    integer(kind=argu_k) :: itel
    character(len=*), parameter :: rname='OBSERVATORY>COPY'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_observatory_reallocate(in%ntel,ou,error)
    if (error) return
    do itel = 1,in%ntel
       call cubetools_obstel_copy(in%tel(itel),ou%tel(itel),error)
    enddo ! itel
  end subroutine cubetools_observatory_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_observatory_consistency_init(cons,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(observatory_cons_t),  intent(out)   :: cons
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>CONSISTENCY>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_init(notol,check,mess,cons%ntel,error)
    if (error) return
    !
  end subroutine cubetools_observatory_consistency_init
  !
  subroutine cubetools_observatory_consistency_check(cons,obs1,obs2,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(observatory_cons_t),  intent(inout) :: cons
    type(observatory_t),target,intent(in)    :: obs1
    type(observatory_t),target,intent(in)    :: obs2
    logical,                   intent(inout) :: error
    !
    integer(kind=4) :: itmin, itmax,ier
    type(observatory_t), pointer :: obsmin,obsmax
    character(len=*), parameter :: rname='OBSERVATORY>CONSISTENCY>CHECK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob =.false.
    !
    call cubetools_consistency_integer_check(cons%ntel,obs1%ntel,obs2%ntel,error)
    if (error) return
    !
    if (obs1%ntel.gt.obs2%ntel) then
       obsmin => obs2
       obsmax => obs1
    else
       obsmin => obs1
       obsmax => obs2
    endif
    if (allocated(cons%tel)) deallocate(cons%tel)
    if (allocated(cons%found)) deallocate(cons%found)
    allocate(cons%tel(obsmin%ntel),cons%found(obsmin%ntel),stat=ier)
    if (failed_allocate(rname,'telescope consistency',ier,error)) return
    cons%n = obsmin%ntel
    !
    cons%found(:) = -1
    do itmin=1,obsmin%ntel
       itmax = 1
       call cubetools_obstel_consistency_init(cons%tel(itmin),error)
       if (error) return
       do while (itmax.le.obsmax%ntel)
          call cubetools_obstel_consistency_check(cons%tel(itmin),obsmin%tel(itmin),obsmax%tel(itmax),error)
          if (error) return
          if (.not.cons%tel(itmin)%name%prob) then
             cons%found(itmin) = itmax
             exit
          endif
          itmax = itmax+1
       enddo
    enddo
    !
    cons%prob = cons%ntel%prob.or.any(cons%tel(:)%prob)
    !
  end subroutine cubetools_observatory_consistency_check
  !
  subroutine cubetools_observatory_consistency_print(cons,obs1,obs2,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(observatory_cons_t),  intent(in)    :: cons
    type(observatory_t),target,intent(in)    :: obs1
    type(observatory_t),target,intent(in)    :: obs2
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>CONSISTENCY>PRINT'
    logical, allocatable :: printed(:)
    integer(kind=4) :: itel,ier
    type(obstel_t) :: emptytel
    type(obstel_cons_t) :: dummycons
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('observatory sections',2,cons%check,cons%prob,error)
    if(error) return
    if (cons%check.and.cons%prob) then
       dummycons%name%prob=.true.
       dummycons%prob=.true.
       emptytel%name = 'Absent'
       call cubetools_consistency_integer_print('size',cons%ntel,obs1%ntel,obs2%ntel,error)
       if (error) return
       allocate(printed(max(obs2%ntel,obs1%ntel)),stat=ier)
       if (failed_allocate(rname,'printed status',ier,error)) return
       printed(:) = .false.
       if (obs1%ntel.le.obs2%ntel) then
          do itel=1,obs1%ntel
             if (cons%found(itel).gt.0) then
                call cubetools_obstel_consistency_print(cons%tel(itel),obs1%tel(itel),&
                     obs2%tel(cons%found(itel)),error)
                if (error) return
                printed(cons%found(itel)) = .true.
             endif
          end do
          do itel=1,obs1%ntel
             if (.not.cons%found(itel).gt.0) then
                call cubetools_obstel_consistency_print(dummycons,obs1%tel(itel),emptytel,error)
                if (error) return
             endif
          enddo
          do itel=1,obs2%ntel
             if (.not.printed(itel)) then
                call cubetools_obstel_consistency_print(dummycons,emptytel,obs2%tel(itel),error)
                if (error) return
             endif
          end do
       else
          do itel=1,obs2%ntel
             if (cons%found(itel).gt.0) then
                call cubetools_obstel_consistency_print(cons%tel(itel),obs1%tel(cons%found(itel)),&
                     obs2%tel(itel),error)
                if (error) return
                printed(cons%found(itel)) = .true.
             endif
          end do      
          do itel=1,obs1%ntel
             if (.not.printed(itel)) then
                call cubetools_obstel_consistency_print(dummycons,obs1%tel(itel),emptytel,error)
                if (error) return
             endif
          end do
          do itel=1,obs2%ntel
             if (.not.cons%found(itel).gt.0) then
                call cubetools_obstel_consistency_print(dummycons,emptytel,obs2%tel(itel),error)
                if (error) return
             endif
          enddo
       endif
    endif
    call cubetools_message(seve%r,rname,'') 
  end subroutine cubetools_observatory_consistency_print
  !
  subroutine cubetools_observatory_consistency_final(cons,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(observatory_cons_t),  intent(out)   :: cons
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>CONSISTENCY>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%ntel,error)
    if (error) return
    !
  end subroutine cubetools_observatory_consistency_final
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_observatory_sort(obs,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(observatory_t), intent(inout) :: obs
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>SORT'
    !
    character(len=tele_l), allocatable :: telnames(:)
    integer(kind=4), allocatable :: telidx(:)
    type(observatory_t) :: tmp
    integer(kind=4) :: ier,itel
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    allocate(telnames(obs%ntel),telidx(obs%ntel),stat=ier)
    if (failed_allocate(rname,'Name list,sort list',ier,error)) return
    telnames(:) = obs%tel(:)%name
    !
    call gch_trie(telnames,telidx,obs%ntel,tele_l,error)
    if (error) return
    !
    call cubetools_observatory_reallocate(obs%ntel,tmp,error)
    if(error) return
    do itel=1,obs%ntel
       call cubetools_obstel_copy(obs%tel(telidx(itel)),tmp%tel(itel),error)
       if (error) return
    enddo
    call cubetools_observatory_copy(tmp,obs,error)
    if (error) return
  end subroutine cubetools_observatory_sort
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_observatory_reallocate(ntel,obs,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=4),     intent(in)    :: ntel
    type(observatory_t), intent(inout) :: obs
    logical,             intent(inout) :: error
    !
    integer(kind=code_k) :: ier
    character(len=*), parameter :: rname='OBSERVATORY>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (allocated(obs%tel)) deallocate(obs%tel)
    allocate(obs%tel(ntel),stat=ier)
    if (failed_allocate(rname,'Telescope section',ier,error)) return
    obs%ntel = ntel
  end subroutine cubetools_observatory_reallocate
  !
  subroutine cubetools_observatory_add_telescope(name,obs,error)
    !-------------------------------------------------------------------
    ! Add a telescope to observatory section
    !-------------------------------------------------------------------
    character(len=tele_l), intent(in)    :: name
    type(observatory_t),   intent(inout) :: obs
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>ADD>TELESCOPE'
    integer(kind=4) :: itel
    type(observatory_t) :: newobs
    type(obstel_t) :: newtel
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do itel=1,obs%ntel
       if (name.eq.obs%tel(itel)%name) then
          call cubetools_message(seve%i,rname,'Telescope '//trim(name)//' already present')
          return
       endif
    end do
    !
    !
    call cubetools_observatory_reallocate(obs%ntel+1,newobs,error)
    if (error) return
    do itel = 1,obs%ntel
       call cubetools_obstel_copy(obs%tel(itel),newobs%tel(itel),error)
    enddo ! itel
    !
    call cubetools_obstel_create(name,newtel,error)
    if (error) return
    if (obs%ntel.ge.1) then
       call cubetools_message(seve%w,rname,'Previous telescopes are kept')
    endif
    call cubetools_obstel_copy(newtel,newobs%tel(newobs%ntel),error)
    !
    call cubetools_observatory_copy(newobs,obs,error)
    if(error) return
  end subroutine cubetools_observatory_add_telescope
    !
  subroutine cubetools_observatory_rm_telescope(name,obs,error)
    !-------------------------------------------------------------------
    ! Remove a telescope from observatory section
    !-------------------------------------------------------------------
    character(len=tele_l), intent(in)    :: name
    type(observatory_t),   intent(inout) :: obs
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSERVATORY>RM>TELESCOPE'
    integer(kind=4) :: itel,otel,found
    type(observatory_t) :: newobs
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    found = code_abs
    do itel=1,obs%ntel
       if (name.eq.obs%tel(itel)%name) then
          found = itel
          exit
       endif
    end do
    if (found.eq.code_abs) then
       call cubetools_message(seve%w,rname,'Telescope '//trim(name)//' is not present')
       return
    endif
    !
    call cubetools_observatory_reallocate(obs%ntel-1,newobs,error)
    if (error) return
    otel = 1
    do itel = 1,obs%ntel
       if (itel.ne.found) then
          call cubetools_obstel_copy(obs%tel(itel),newobs%tel(otel),error)
          otel = otel+1
       endif
    enddo ! itel
    !
    call cubetools_observatory_copy(newobs,obs,error)
    if(error) return
  end subroutine cubetools_observatory_rm_telescope
  !
  subroutine cubetools_observatory_add_telescopes(source,target,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Add source telescopes to target
    !-------------------------------------------------------------------
    type(observatory_t),   intent(in)    :: source
    type(observatory_t),   intent(inout) :: target
    logical,               intent(inout) :: error
    !
    type(observatory_t) :: newobs
    integer(kind=4) :: isou, itar, otel, nnew, ier
    integer(kind=4),allocatable :: new(:)
    integer(kind=4),parameter :: no=0,yes=1
    character(len=*), parameter :: rname='OBSERVATORY>ADD>TELESCOPES'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    allocate(new(source%ntel),stat=ier)
    if (failed_allocate(rname,'new telescopes',ier,error)) return
    new(:) = yes
    do isou=1,source%ntel
       do itar=1,target%ntel
          if (cubetools_obstel_identical(source%tel(isou),target%tel(itar))) new(isou) = no
       end do
    enddo
    nnew = sum(new)
    if (nnew.eq.no) return
    !
    call cubetools_observatory_reallocate(target%ntel+nnew,newobs,error)
    if (error) return
    otel = 0
    do itar=1,target%ntel
       otel = otel+1
       call cubetools_obstel_copy(target%tel(itar),newobs%tel(otel),error)
       if (error) return
    end do
    do isou=1,source%ntel
       if (new(isou).eq.yes) then
          otel = otel+1
          call cubetools_obstel_copy(source%tel(isou),newobs%tel(otel),error)
          if (error) return
       endif
    enddo
    call cubetools_observatory_copy(newobs,target,error)
    if (error) return
  end subroutine cubetools_observatory_add_telescopes
  !
  subroutine cubetools_observatory_tostr(obs,string,error)
    use gkernel_interfaces
    use cubetools_string
    !-------------------------------------------------------------------
    ! Create a human friendly string representation of an observatory_t,
    ! e.g. 30M,NOEMA (used e.g. in command LIST)
    !-------------------------------------------------------------------
    class(observatory_t), intent(in)    :: obs
    character(len=*),     intent(out)   :: string
    logical,              intent(inout) :: error
    !
    character(len=tele_l), allocatable :: names(:)
    integer(kind=4) :: ier,itel
    character(len=*), parameter :: rname='OBSERVATORY>TOSTR'
    !
    if (obs%ntel.le.0) then
      string = strg_unk
      return
    endif
    !
    allocate(names(obs%ntel),stat=ier)
    if (failed_allocate(rname,'Tel names',ier,error))  return
    do itel=1,obs%ntel
      names(itel) = obs%tel(itel)%name
    enddo
    call cubetools_string_concat(obs%ntel,names,',',string,error)
    if (error)  return
    deallocate(names)
  end subroutine cubetools_observatory_tostr
  !
  subroutine cubetools_observatory_write(obs,lun,error)
    !-------------------------------------------------------------------
    ! Write the observatory to the given logical unit
    !-------------------------------------------------------------------
    class(observatory_t), intent(in)    :: obs
    integer(kind=4),      intent(in)    :: lun
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: itel
    !
    write(lun,form_i4) 'OBSERVATORY_NTEL',obs%ntel
    do itel=1,obs%ntel
      call obs%tel(itel)%write(lun,error)
      if (error)  return
    enddo
  end subroutine cubetools_observatory_write
  !
  subroutine cubetools_observatory_read(obs,lun,error)
    !-------------------------------------------------------------------
    ! Read the observatory to the given logical unit
    !-------------------------------------------------------------------
    class(observatory_t), intent(inout) :: obs
    integer(kind=4),      intent(in)    :: lun
    logical,              intent(inout) :: error
    !
    character(len=key_l) :: key
    integer(kind=4) :: itel
    !
    call cubetools_observatory_final(obs,error)
    if (error)  return
    !
    read(lun,form_i4) key,obs%ntel
    call cubetools_observatory_reallocate(obs%ntel,obs,error)
    if (error) return
    !
    do itel=1,obs%ntel
      call obs%tel(itel)%read(lun,error)
      if (error)  return
    enddo
  end subroutine cubetools_observatory_read
end module cubetools_observatory_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
