!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_obstel_types
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_consistency_types
  !
  public :: obstel_t,obstel_cons_t
  public :: cubetools_obstel_init,cubetools_obstel_get_and_derive
  public :: cubetools_obstel_final,cubetools_obstel_put
  public :: cubetools_obstel_list,cubetools_obstel_sicdef,cubetools_obstel_copy
  public :: cubetools_obstel_consistency_init,cubetools_obstel_consistency_final
  public :: cubetools_obstel_consistency_check,cubetools_obstel_consistency_print
  public :: cubetools_obstel_identical,cubetools_obstel_create,cubetools_obstel_tel2userstruct
  private
  !
  type obstel_t
     real(kind=coor_k)     :: lon = 0d0       ! [rad] Longitude
     real(kind=coor_k)     :: lat = 0d0       ! [rad] Latitude
     real(kind=real_k)     :: alt = 0.0       ! [  m] Altitude
     real(kind=real_k)     :: diam = 0.0      ! [  m] Diameter
     character(len=tele_l) :: name = strg_unk ! [---] Name
  contains
     procedure :: write => cubetools_obstel_write
     procedure :: read  => cubetools_obstel_read
  end type obstel_t
  !
  type obstel_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)        :: name
     type(consistency_desc_t)        :: lon
     type(consistency_desc_t)        :: lat
     type(consistency_desc_t)        :: alt
     type(consistency_desc_t)        :: diam
  end type obstel_cons_t
  !
  integer(kind=4), parameter :: key_l=24  ! Note the T26 tab below
  character(len=*), parameter :: form_tel='(A,T26,A12,2(1PG25.16),2(1PG15.7))'
  !
contains
  !
  subroutine cubetools_obstel_init(obstel,error)
    !-------------------------------------------------------------------
    ! Just initialize the type, ie, set it intent(out)
    !-------------------------------------------------------------------
    type(obstel_t), intent(out)   :: obstel
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_obstel_init
  !
  subroutine cubetools_obstel_get_and_derive(lon,lat,alt,diam,name,obstel,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    real(kind=coor_k),     intent(in)    :: lon
    real(kind=coor_k),     intent(in)    :: lat
    real(kind=real_k),     intent(in)    :: alt
    real(kind=real_k),     intent(in)    :: diam
    character(len=tele_l), intent(in)    :: name
    type(obstel_t),        intent(inout) :: obstel
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>GET>AND>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    obstel%lon = lon
    obstel%lat = lat
    obstel%alt = alt
    obstel%diam = diam
    obstel%name = name
  end subroutine cubetools_obstel_get_and_derive
  !
  subroutine cubetools_obstel_put(obstel,lon,lat,alt,diam,name,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(obstel_t),        intent(in)    :: obstel
    real(kind=coor_k),     intent(out)   :: lon
    real(kind=coor_k),     intent(out)   :: lat
    real(kind=real_k),     intent(out)   :: alt
    real(kind=real_k),     intent(out)   :: diam
    character(len=tele_l), intent(out)   :: name
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>PUT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    lon = obstel%lon
    lat = obstel%lat
    alt = obstel%alt
    diam = obstel%diam
    name = obstel%name
  end subroutine cubetools_obstel_put
  !
  subroutine cubetools_obstel_final(obstel,error)
    !-------------------------------------------------------------------
    ! Just reinitialize the type, ie, set it intent(out)
    !-------------------------------------------------------------------
    type(obstel_t), intent(out)   :: obstel
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_obstel_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_obstel_list(obstel,error)
    use ieee_arithmetic
    use gkernel_interfaces
    use cubetools_format
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(obstel_t), intent(in)    :: obstel
    logical,        intent(inout) :: error
    !
    character(len=15) :: lat,lon
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='OBSTEL>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    mess = cubetools_format_stdkey_boldval('Tel',obstel%name,10)
    if (ieee_is_nan(obstel%lon)) then
      mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Lon',obstel%lon,'f7.2',18)  ! NaN
    else
      call rad2sexa(obstel%lon,360,lon)
      mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Lon',lon,18)
    endif
    if (ieee_is_nan(obstel%lat)) then
      mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Lat',obstel%lat,'f7.2',18)  ! NaN
    else
      call rad2sexa(obstel%lat,360,lat)
      mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Lat',lat,18)
    endif
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Alt',obstel%alt,'f7.2',12)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Dia',obstel%diam,'f5.1',10)
    call cubetools_message(seve%r,rname,mess)
  end subroutine cubetools_obstel_list
  !
  subroutine cubetools_obstel_sicdef(name,obstel,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(obstel_t),   intent(in)    :: obstel
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>SICDEF'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_dble(trim(name)//'%lon',obstel%lon,0,0,readonly,error)
    if (error) return
    call sic_def_dble(trim(name)//'%lat',obstel%lat,0,0,readonly,error)
    if (error) return
    call sic_def_real(trim(name)//'%alt',obstel%alt,0,0,readonly,error)
    if (error) return
    call sic_def_real(trim(name)//'%diam',obstel%diam,0,0,readonly,error)
    if (error) return
    call sic_def_charn(trim(name)//'%name',obstel%name,0,0,readonly,error)
    if (error) return
  end subroutine cubetools_obstel_sicdef
  !
  subroutine cubetools_obstel_tel2userstruct(obstel,userstruct,error)
    use cubetools_userstruct
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(obstel_t),     intent(in)    :: obstel
    type(userstruct_t), intent(in)    :: userstruct
    logical,            intent(inout) :: error
    !
    character(len=argu_l) :: lon,lat
    character(len=*), parameter :: rname='OBSTEL>TEL2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! User struct is created as substructure on the calling routine
    call rad2sexa(obstel%lon,360,lon)
    call rad2sexa(obstel%lat,360,lat)
    call userstruct%set_member('lon',adjustl(lon),error)
    if (error) return
    call userstruct%set_member('lat',adjustl(lat),error)
    if (error) return
    call userstruct%set_member('alt',obstel%alt,error)
    if (error) return
    call userstruct%set_member('diam',obstel%diam,error)
    if (error) return
    call userstruct%set_member('name',obstel%name,error)
    if (error) return
  end subroutine cubetools_obstel_tel2userstruct
  !
  subroutine cubetools_obstel_copy(in,ou,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(obstel_t), intent(in)    :: in
    type(obstel_t), intent(out)   :: ou
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>COPY'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ou = in
  end subroutine cubetools_obstel_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_obstel_consistency_init(cons,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(obstel_cons_t), intent(inout) :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>CONSISTENCY>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_init(notol,check,mess,cons%name,error)
    if (error) return
    call cubetools_consistency_init(strict,check,mess,cons%lon,error)
    if (error) return
    call cubetools_consistency_init(strict,check,mess,cons%lat,error)
    if (error) return
    call cubetools_consistency_init(strict,check,mess,cons%alt,error)
    if (error) return
    call cubetools_consistency_init(strict,check,mess,cons%diam,error)
    if (error) return
  end subroutine cubetools_obstel_consistency_init
  !
  subroutine cubetools_obstel_consistency_check(cons,tel1,tel2,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(obstel_cons_t), intent(inout) :: cons
    type(obstel_t),      intent(in)    :: tel1
    type(obstel_t),      intent(in)    :: tel2
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>CONSISTENCY>CHECK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .false.
    call cubetools_consistency_string_check(cons%name,tel1%name,tel2%name,error)
    if (error) return
    !if (cons%name%prob) return
    call cubetools_consistency_real_check(cons%lon,tel1%lon,tel2%lon,error)
    if (error) return
    call cubetools_consistency_real_check(cons%lat,tel1%lat,tel2%lat,error)
    if (error) return
    call cubetools_consistency_real_check(cons%alt,tel1%alt,tel2%alt,error)
    if (error) return
    call cubetools_consistency_real_check(cons%diam,tel1%diam,tel2%diam,error)
    if (error) return
    !
    cons%prob = cons%name%prob.or.cons%lon%prob.or.cons%lat%prob.or.cons%alt%prob.or.cons%diam%prob
  end subroutine cubetools_obstel_consistency_check
  !
   subroutine cubetools_obstel_consistency_print(cons,tel1,tel2,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(obstel_cons_t), intent(in)    :: cons
    type(obstel_t),      intent(in)    :: tel1
    type(obstel_t),      intent(in)    :: tel2
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>CONSISTENCY>PRINT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('telescopes '//trim(tel1%name)//' & '//trim(tel2%name),&
         3,cons%check,cons%prob,error,short=.true.)
    if (error) return
    if (cons%name%prob) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_string_print('Names',cons%name,tel1%name,tel2%name,error)
       if (error) return
       call cubetools_consistency_real_print('Longitudes',cons%lon,tel1%lon,tel2%lon,error)
       if (error) return
       call cubetools_consistency_real_print('Latitudes',cons%lat,tel1%lat,tel2%lat,error)
       if (error) return
       call cubetools_consistency_real_print('Altitudes',cons%alt,tel1%alt,tel2%alt,error)
       if (error) return
       call cubetools_consistency_real_print('Diameters',cons%diam,tel1%diam,tel2%diam,error)
       if (error) return
       call cubetools_message(seve%r,rname,'') 
    endif
    !
  end subroutine cubetools_obstel_consistency_print
  !
  subroutine cubetools_obstel_consistency_final(cons,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(obstel_cons_t), intent(inout) :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>CONSISTENCY>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%name,error)
    if (error) return
    call cubetools_consistency_final(cons%lon,error)
    if (error) return
    call cubetools_consistency_final(cons%lat,error)
    if (error) return
    call cubetools_consistency_final(cons%alt,error)
    if (error) return
    call cubetools_consistency_final(cons%diam,error)
    if (error) return
  end subroutine cubetools_obstel_consistency_final
  !
  !----------------------------------------------------------------------
  !
  function cubetools_obstel_identical(tel1,tel2) result(identical)
    !-------------------------------------------------------------------
    ! Return true if two obstel_t instances are equal
    !-------------------------------------------------------------------
    logical                    :: identical
    type(obstel_t), intent(in) :: tel1
    type(obstel_t), intent(in) :: tel2
    !
    identical = tel1%lon.eq.tel2%lon
    identical = tel1%lat.eq.tel2%lat.and.identical
    identical = tel1%alt.eq.tel2%alt.and.identical
    identical = tel1%diam.eq.tel2%diam.and.identical
    identical = tel1%name.eq.tel2%name.and.identical
  end function cubetools_obstel_identical
  !
  subroutine cubetools_obstel_create(name,obstel,error)
    use image_def
    use gkernel_interfaces
    use phys_const
    use cubetools_nan
    !-------------------------------------------------------------------
    ! Create a obstel object from a name, pulls from telescope info
    ! from the kernel
    !-------------------------------------------------------------------
    character(len=tele_l), intent(in)    :: name
    type(obstel_t),        intent(out)   :: obstel
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBSTEL>CREATE'
    !
    type(telesco) :: gtel
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (gwcs_observatory_exists(name)) then
      ! Known by GILDAS
      call gwcs_observatory(name,gtel,error)
      if (error)  return
      call cubetools_obstel_get_and_derive(  &
        gtel%lon*rad_per_deg,  &
        gtel%lat*rad_per_deg,  &
        gtel%alt,              &
        gtel%diam,             &
        gtel%ctele,            &
        obstel,error)
      if (error)  return
    else
      ! Unknown telescope. Add it but for now use NaN parameters.
      ! We should have a way to provide the parameters by some external
      ! means (e.g. user input). Beware also of space telescopes!
      call cubetools_obstel_get_and_derive(  &
        gr8nan,  &
        gr8nan,  &
        gr4nan,  &
        gr4nan,  &
        name,    &
        obstel,error)
      if (error)  return
    endif
  end subroutine cubetools_obstel_create
  !
  subroutine cubetools_obstel_write(obstel,lun,error)
    !-------------------------------------------------------------------
    ! Write the observatory to the given logical unit
    !-------------------------------------------------------------------
    class(obstel_t), intent(in)    :: obstel
    integer(kind=4), intent(in)    :: lun
    logical,         intent(inout) :: error
    !
    write(lun,form_tel)  'OBSTEL',     &
                         obstel%name,  &
                         obstel%lon,   &
                         obstel%lat,   &
                         obstel%alt,   &
                         obstel%diam
  end subroutine cubetools_obstel_write
  !
  subroutine cubetools_obstel_read(obstel,lun,error)
    !-------------------------------------------------------------------
    ! Read the observatory from the given logical unit
    !-------------------------------------------------------------------
    class(obstel_t), intent(inout) :: obstel
    integer(kind=4), intent(in)    :: lun
    logical,         intent(inout) :: error
    !
    character(len=key_l) :: key
    !
    read(lun,form_tel)  key,          &
                        obstel%name,  &
                        obstel%lon,   &
                        obstel%lat,   &
                        obstel%alt,   &
                        obstel%diam
  end subroutine cubetools_obstel_read
  !
end module cubetools_obstel_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
