module cubetools_header_vo
  use cubetools_parameters
  use cubetools_header_interface
  use cubetools_header_types

  interface json_keyval_write
    module procedure json_keyval_write_i4
    module procedure json_keyval_write_i8
    module procedure json_keyval_write_r8
    module procedure json_keyval_write_ch
  end interface json_keyval_write

  interface cubetools_header_vo_list
    module procedure cubetools_header_vo_list_interface
    module procedure cubetools_header_vo_list_header
  end interface cubetools_header_vo_list

  integer(kind=code_k), parameter :: vo_version=1

  public :: cubetools_header_vodesc_list,cubetools_header_vo_list
  private

contains

  subroutine cubetools_header_vodesc_list(error)
    !-------------------------------------------------------------------
    ! Display the VO format description
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    call json_main_write_start()
    !
    call json_dict_write_start('description')
    call json_keyval_write('VERSION',vo_version)
    call json_vo_description('software_version',.false.,"string")
    call json_vo_description('dataproduct_type',.true.,"string")
    call json_vo_description('dataproduct_subtype',.false.,"string")
    call json_vo_description('calib_level',.true.,"enum integer")
    call json_vo_description('access_format',.true.,"string")
    call json_vo_description('access_estsize',.true.,"integer",unit='kB')
    call json_vo_description('target_name',.true.,"string")
    call json_vo_description('s_ra',.true.,"float",unit="degree")
    call json_vo_description('s_dec',.true.,"float",unit="degree")
    call json_vo_description('s_fov',.true.,"float",unit="degree")
    call json_vo_description('s_region',.true.,"string")
    call json_vo_description('s_xel1',.true.,"integer")
    call json_vo_description('s_xel2',.true.,"integer")
    call json_vo_description('s_resolution',.true.,"float",unit="arcsec")
    call json_vo_description('s_pixel_scale',.true.,"float",unit="arcsec")
    call json_vo_description('em_ucd',.false.,"string")
    call json_vo_description('em_min',.true.,"float",unit="Hz")
    call json_vo_description('em_max',.true.,"float",unit="Hz")
    call json_vo_description('em_res_power',.true.,"float")
    call json_vo_description('em_xel',.true.,"integer")
    call json_vo_description('pol_states',.true.,"string")
    call json_vo_description('facility_name',.true.,"string",last=.true.)
    call json_dict_write_stop(last=.true.)
    !
    call json_main_write_stop()
    !
  end subroutine cubetools_header_vodesc_list

  subroutine cubetools_header_vo_list_interface(interf,error)
    !-------------------------------------------------------------------
    ! Display the interface_t under VO format
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(in)    :: interf
    logical,                       intent(inout) :: error
    !
    type(cube_header_t) :: head
    !
    call head%init(error)
    if (error)  return
    call cubetools_header_import_and_derive(interf,head,error)
    if (error)  return
    call cubetools_header_vo_list_header(head,error)
    if (error)  return
    call cubetools_header_final(head,error)
    if (error)  return
  end subroutine cubetools_header_vo_list_interface

  subroutine cubetools_header_vo_list_header(head,error)
    use phys_const
    use gkernel_interfaces
    use cubetools_parameters
    !-------------------------------------------------------------------
    ! Display the header_t under VO format
    !-------------------------------------------------------------------
    type(cube_header_t), intent(in)    :: head
    logical,             intent(inout) :: error
    !
    integer(kind=data_k) :: datasize
    real(kind=8) :: reso
    real(kind=coor_k) :: ffirst,flast,fmin,fmax,wpower,pixsize
    real(kind=coor_k) :: axcent,aycent,axcorn(4),aycorn(4),fov
    character(len=128) :: version,region
    integer(kind=4) :: ier
    !
    version = ''
    ier = sic_getlog('GAG_VERSION',version)
    ier = index(version,' ')
    version = version(1:ier)
    !
    datasize = head%spa%l%n*head%spa%m%n*head%spe%nc/256  ! [kB] ndata*4/1024
    !
    call convert_fov(head%spa,axcent,aycent,axcorn,aycorn,fov,error)
    write(region,'(A,8(1X,F5.1),A1)') 'ICRS (Polygon',      &
                                      axcorn(1),aycorn(1),  &
                                      axcorn(2),aycorn(2),  &
                                      axcorn(3),aycorn(3),  &
                                      axcorn(4),aycorn(4),')'
    !
    reso = sqrt(head%spa%bea%major*head%spa%bea%minor)/rad_per_sec
    pixsize = sqrt(abs(head%spa%l%inc*head%spa%m%inc))/rad_per_sec
    !
    ffirst = head%spe%f%coord(1)*1.d6            ! [Hz]
    flast  = head%spe%f%coord(head%spe%nc)*1.d6  ! [Hz]
    fmin = min(ffirst,flast)
    fmax = max(ffirst,flast)
    wpower = abs(head%spe%f%val/head%spe%f%inc)
    !
    call json_main_write_start()
    !
    call json_dict_write_start('values')
    call json_keyval_write('VERSION',vo_version)
    call json_keyval_write('software_version',version)
    call json_keyval_write('dataproduct_type','cube')
    call json_keyval_write('dataproduct_subtype','???')
    call json_keyval_write('calib_level',3)
    call json_keyval_write('access_format','image/fits')
    call json_keyval_write('access_estsize',datasize)
    call json_keyval_write('target_name',head%spa%source)
    call json_keyval_write('s_ra',axcent)
    call json_keyval_write('s_dec',aycent)
    call json_keyval_write('s_fov',fov)
    call json_keyval_write('s_region',region)
    call json_keyval_write('s_xel1',head%spa%l%n)
    call json_keyval_write('s_xel2',head%spa%m%n)
    call json_keyval_write('s_resolution',reso)
    call json_keyval_write('s_pixel_scale',pixsize)
    call json_keyval_write('em_ucd','em.freq')
    call json_keyval_write('em_min',fmin)
    call json_keyval_write('em_max',fmax)
    call json_keyval_write('em_res_power',wpower)
    call json_keyval_write('em_xel',head%spe%nc)
    call json_keyval_write('pol_states','/I/')
    call json_keyval_write('facility_name','IRAM',last=.true.)
    call json_dict_write_stop(last=.true.)
    !
    call json_main_write_stop()
    !
  end subroutine cubetools_header_vo_list_header

  subroutine convert_fov(spa,axcent,aycent,axcorn,aycorn,fov,error)
    use phys_const
    use gkernel_types
    use gkernel_interfaces
    use cubetools_spatial_types
    !-------------------------------------------------------------------
    ! Compute the FOV description (center, corners, size)
    !-------------------------------------------------------------------
    type(spatial_t), intent(in)    :: spa                  !
    real(kind=8),    intent(out)   :: axcent,aycent        ! [deg]
    real(kind=8),    intent(out)   :: axcorn(4),aycorn(4)  ! [deg]
    real(kind=8),    intent(out)   :: fov                  ! [deg]
    logical,         intent(inout) :: error                !
    !
    type(projection_t) :: proj
    real(kind=8) :: rxcent,rycent
    real(kind=8) :: rxcorn(4),rycorn(4)
    real(kind=8) :: diag(2)
    !
    ! Setup projection
    call gwcs_projec(spa%pro%l0,spa%pro%m0,spa%pro%pa,spa%pro%code,  &
      proj,error)
    if (error)  return
    !
    ! Convert FOV center from relative to absolute
    rxcent = (spa%l%coord(1)+spa%l%coord(spa%l%n))/2.d0
    rycent = (spa%m%coord(1)+spa%m%coord(spa%m%n))/2.d0
    call rel_to_abs(proj,rxcent,rycent,axcent,aycent,1)
    !
    ! Convert FOV corners from relative to absolute coordinates
    rxcorn(1) = spa%l%get_min()
    rxcorn(2) = spa%l%get_max()
    rxcorn(3) = spa%l%get_max()
    rxcorn(4) = spa%l%get_min()
    rycorn(1) = spa%m%get_min()
    rycorn(2) = spa%m%get_min()
    rycorn(3) = spa%m%get_max()
    rycorn(4) = spa%m%get_max()
    call rel_to_abs(proj,rxcorn,rycorn,axcorn,aycorn,4)
    !
    ! Compute FOV (largest diagonal)
    diag(1) = haversine(axcorn(1),aycorn(1),axcorn(3),aycorn(3))
    diag(2) = haversine(axcorn(2),aycorn(2),axcorn(4),aycorn(4))
    fov = maxval(diag)
    !
    ! Convert to degrees
    axcent = axcent/rad_per_deg
    aycent = aycent/rad_per_deg
    axcorn = axcorn/rad_per_deg
    aycorn = aycorn/rad_per_deg
    fov    = fov/rad_per_deg
  end subroutine convert_fov

  function haversine(ra1,dec1,ra2,dec2)
    !-------------------------------------------------------------------
    ! Use the haversine formula which is numerically better-conditioned
    ! for small distances
    !-------------------------------------------------------------------
    real(kind=8) :: haversine
    real(kind=8), intent(in) :: ra1,dec1
    real(kind=8), intent(in) :: ra2,dec2
    !
    real(kind=8) :: dra,ddec,term1,term2
    !
    dra = abs(ra1-ra2)
    ddec = abs(dec1-dec2)
    !
    term1 = sin(ddec/2)**2
    term2 = cos(dec1)*cos(dec2)*sin(dra/2)**2
    haversine = 2*asin(sqrt(term1+term2))
  end function haversine

  !---------------------------------------------------------------------

  subroutine json_vo_description(key,mandatory,type,unit,last)
    !-------------------------------------------------------------------
    ! Write one VO entry description
    !-------------------------------------------------------------------
    character(len=*), intent(in)           :: key
    logical,          intent(in)           :: mandatory
    character(len=*), intent(in)           :: type
    character(len=*), intent(in), optional :: unit
    logical,          intent(in), optional :: last
    ! Local
    character(len=128) :: value
    !
    write(value,'(4A)')  '{',  &
                         trim(json_keyval_l42str('mandatory',mandatory)),  &
                         ', ',  &
                         trim(json_keyval_ch2str('type',type))
    if (present(unit)) then
      write(value,'(4A)')  trim(value),  &
                           ', ',  &
                           trim(json_keyval_ch2str('unit',unit)),  &
                           '}'
    else
      write(value,'(2A)')  trim(value),  &
                           '}'
    endif
    !
    call json_keyval_write_any(key,value,last)
  end subroutine json_vo_description

  !---------------------------------------------------------------------

  subroutine json_main_write_start()
    !-------------------------------------------------------------------
    ! Start the main JSON block
    !-------------------------------------------------------------------
    write(*,'(A)')  '{'
  end subroutine json_main_write_start

  subroutine json_main_write_stop()
    !-------------------------------------------------------------------
    ! Stop the main JSON block
    !-------------------------------------------------------------------
    write(*,'(A)')  '}'
  end subroutine json_main_write_stop

  subroutine json_dict_write_start(name)
    !-------------------------------------------------------------------
    ! Start a JSON dictionary
    !-------------------------------------------------------------------
    character(len=*), intent(in) :: name
    !
    write(*,'(3A)')  '"',trim(name),'": {'
  end subroutine json_dict_write_start

  subroutine json_dict_write_stop(last)
    !-------------------------------------------------------------------
    ! Stop a JSON dictionary
    !-------------------------------------------------------------------
    logical, intent(in), optional :: last
    !
    if (present(last)) then
      if (last) then
        write(*,'(A)')  '}'
        return
      endif
    endif
    write(*,'(A)')  '},'
  end subroutine json_dict_write_stop

  function json_keyval_ch2str(key,value)
    !-------------------------------------------------------------------
    ! Create a key + string value pair as a string with proper
    ! formatting
    !-------------------------------------------------------------------
    character(len=128) :: json_keyval_ch2str
    character(len=*), intent(in) :: key
    character(len=*), intent(in) :: value
    ! Local
    character(len=128) :: string
    !
    write(string,'(A1,A,A1)')  '"',trim(value),'"'
    json_keyval_ch2str = json_keyval_any2str(key,string)
  end function json_keyval_ch2str

  function json_keyval_r82str(key,value)
    !-------------------------------------------------------------------
    ! Create a key + R*8 value pair as a string with proper formatting
    !-------------------------------------------------------------------
    character(len=128) :: json_keyval_r82str
    character(len=*), intent(in) :: key
    real(kind=8),     intent(in) :: value
    ! Local
    character(len=24) :: string
    !
    write(string,'(A1,1PG0.16,A1)')  '"',value,'"'
    json_keyval_r82str = json_keyval_any2str(key,string)
  end function json_keyval_r82str

  function json_keyval_i82str(key,value)
    !-------------------------------------------------------------------
    ! Create a key + I*8 value pair as a string with proper formatting
    !-------------------------------------------------------------------
    character(len=128) :: json_keyval_i82str
    character(len=*), intent(in) :: key
    integer(kind=8),  intent(in) :: value
    ! Local
    character(len=24) :: string
    !
    write(string,'(A1,I0,A1)')  '"',value,'"'
    json_keyval_i82str = json_keyval_any2str(key,string)
  end function json_keyval_i82str

  function json_keyval_l42str(key,value)
    !-------------------------------------------------------------------
    ! Create a key + logical value pair as a string with proper
    ! formatting
    !-------------------------------------------------------------------
    character(len=128) :: json_keyval_l42str
    character(len=*), intent(in) :: key
    logical,          intent(in) :: value
    ! Local
    character(len=5) :: string
    !
    if (value) then
      string = 'true'
    else
      string = 'false'
    endif
    json_keyval_l42str = json_keyval_any2str(key,string)
  end function json_keyval_l42str

  function json_keyval_any2str(key,value)
    !-------------------------------------------------------------------
    ! Create a key + preformatted string pair as a string (not
    ! formatting)
    !-------------------------------------------------------------------
    character(len=128) :: json_keyval_any2str
    character(len=*), intent(in) :: key
    character(len=*), intent(in) :: value
    !
    write(json_keyval_any2str,'(4A)')  '"',trim(key),'": ',trim(value)
  end function json_keyval_any2str

  subroutine json_keyval_write_i4(key,value,last)
    !-------------------------------------------------------------------
    ! Write to screen a key + I*4 value with proper formatting
    !-------------------------------------------------------------------
    character(len=*), intent(in)           :: key
    integer(kind=4),  intent(in)           :: value
    logical,          intent(in), optional :: last
    !
    character(len=1) :: trail
    !
    trail = ','
    if (present(last)) then
      if (last)  trail = ' '
    endif
    write(*,'(2A)')  trim(json_keyval_i82str(key,int(value,kind=8))),trail
  end subroutine json_keyval_write_i4

  subroutine json_keyval_write_i8(key,value,last)
    !-------------------------------------------------------------------
    ! Write to screen a key + I*8 value with proper formatting
    !-------------------------------------------------------------------
    character(len=*), intent(in)           :: key
    integer(kind=8),  intent(in)           :: value
    logical,          intent(in), optional :: last
    !
    character(len=1) :: trail
    !
    trail = ','
    if (present(last)) then
      if (last)  trail = ' '
    endif
    write(*,'(2A)')  trim(json_keyval_i82str(key,value)),trail
  end subroutine json_keyval_write_i8

  subroutine json_keyval_write_r8(key,value,last)
    !-------------------------------------------------------------------
    ! Write to screen a key + R*8 value with proper formatting
    !-------------------------------------------------------------------
    character(len=*), intent(in)           :: key
    real(kind=8),     intent(in)           :: value
    logical,          intent(in), optional :: last
    !
    character(len=1) :: trail
    !
    trail = ','
    if (present(last)) then
      if (last)  trail = ' '
    endif
    write(*,'(2A)')  trim(json_keyval_r82str(key,value)),trail
  end subroutine json_keyval_write_r8

  subroutine json_keyval_write_ch(key,value,last)
    !-------------------------------------------------------------------
    ! Write to screen a key + character string value with proper
    ! formatting
    !-------------------------------------------------------------------
    character(len=*), intent(in)           :: key
    character(len=*), intent(in)           :: value
    logical,          intent(in), optional :: last
    !
    character(len=1) :: trail
    !
    trail = ','
    if (present(last)) then
      if (last)  trail = ' '
    endif
    write(*,'(2A)')  trim(json_keyval_ch2str(key,value)),trail
  end subroutine json_keyval_write_ch

  subroutine json_keyval_write_any(key,value,last)
    !-------------------------------------------------------------------
    ! Write to screen a key + character string value with no formatting
    !-------------------------------------------------------------------
    character(len=*), intent(in)           :: key
    character(len=*), intent(in)           :: value
    logical,          intent(in), optional :: last
    !
    character(len=1) :: trail
    !
    trail = ','
    if (present(last)) then
      if (last)  trail = ' '
    endif
    write(*,'(2A)')  trim(json_keyval_any2str(key,value)),trail
  end subroutine json_keyval_write_any

end module cubetools_header_vo
