!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_spafra_types
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_consistency_types
  use cubetools_structure
  use cubetools_keyword_arg
  !
  public :: spafra_t,spafra_user_t,spafra_cons_t,spafra_opt_t
  public :: cubetoools_spafra_spafra2userstruct
  public :: cubetools_spafra_init,cubetools_spafra_put_and_derive
  public :: cubetools_spafra_final,cubetools_spafra_get
  public :: cubetools_spafra_list
  public :: cubetools_spafra_sicdef,cubetools_spafra_copy
  public :: cubetools_spafra_consistency_check,cubetools_spafra_consistency_print
  public :: cubetools_spafra_consistency_init,cubetools_spafra_consistency_final
  private
  !
  type spafra_t
     integer(kind=code_k) :: code = code_unk ! [---] Frame code (ICRS, Galactic, Equatorial, ...)
     real(kind=equi_k)    :: equinox = 0.0   ! [---] Equinox
  end type spafra_t
  !
  type spafra_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: type_arg
   contains
     procedure :: register  => cubetools_spafra_register
     procedure :: parse     => cubetools_spafra_parse
     procedure :: user2prog => cubetools_spafra_user2prog
  end type spafra_opt_t
  !
  type spafra_user_t
     character(len=argu_l) :: type    = strg_unk ! Frame type
     character(len=argu_l) :: equinox = strg_unk ! Equinox
     logical               :: do      = .false.  ! Option was present
  end type spafra_user_t
  !
  type spafra_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) :: code
     type(consistency_desc_t) :: equinox
  end type spafra_cons_t
  !
contains
  !
  subroutine cubetools_spafra_init(spafra,error)
    !-------------------------------------------------------------------
    ! Just initialize the type, ie, set it intent(out)
    !-------------------------------------------------------------------
    type(spafra_t), intent(out)   :: spafra
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_spafra_init
  !
  subroutine cubetools_spafra_put_and_derive(code,equinox,spafra,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: code
    real(kind=equi_k),    intent(in)    :: equinox
    type(spafra_t),       intent(inout) :: spafra
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>PUT>AND>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    spafra%code = code
    spafra%equinox = equinox
  end subroutine cubetools_spafra_put_and_derive
  !
  subroutine cubetools_spafra_get(spafra,code,equinox,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(spafra_t),       intent(in)    :: spafra
    integer(kind=code_k), intent(out)   :: code
    real(kind=equi_k),    intent(out)   :: equinox
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>GET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    code = spafra%code
    equinox = spafra%equinox
  end subroutine cubetools_spafra_get
  !
  subroutine cubetools_spafra_final(spafra,error)
    !-------------------------------------------------------------------
    ! Just reinitialize the type, ie, set it intent(out)
    !-------------------------------------------------------------------
    type(spafra_t), intent(out)   :: spafra
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_spafra_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_spafra_list(spafra,error)
    !-------------------------------------------------------------------
    ! Empty method until there is a clear usecase
    !-------------------------------------------------------------------
    type(spafra_t), intent(in)    :: spafra
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_spafra_list
  !
  subroutine cubetools_spafra_register(spafra,abstract,error)
    use cubetools_header_interface
    !----------------------------------------------------------------------
    ! Register a /SPATIALFRAME option under a given name and abstract
    !----------------------------------------------------------------------
    class(spafra_opt_t), intent(out)   :: spafra
    character(len=*),    intent(in)    :: abstract
    logical,             intent(inout) :: error
    !
    type(keyword_arg_t)  :: keyarg
    type(standard_arg_t) :: stdarg
    !
    character(len=*), parameter :: rname='SPAFRA>REGISTER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         'SPATIALFRAME','frame [epoch]',&
         abstract,&
         'Frame can be Equatorial, Galactic, ICRS or Unknown',&
         spafra%opt,error)
    if (error) return
    call keyarg%register( &
         'type',  &
         'type of spatial frame', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         spaframes, &
         .not.flexible,  &
         spafra%type_arg, &
         error)
    if (error) return
    call stdarg%register( &
         'epoch',  &
         'Epoch of the spatial frame, if equatorial', &
         '"=" means unchanged, "*" means 2000',&
         code_arg_optional, &
         error)
    if (error) return
  end subroutine cubetools_spafra_register
  !
  subroutine cubetools_spafra_parse(spafra,line,user,error)
    !----------------------------------------------------------------------
    ! Parse spatial 
    ! /SPATIALFRAME spafra [equinox]
    !----------------------------------------------------------------------
    class(spafra_opt_t), intent(in)    :: spafra
    character(len=*),    intent(in)    :: line
    type(spafra_user_t), intent(out)   :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%type    = strg_star
    user%equinox = strg_star
    !
    call spafra%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,spafra%opt,1,user%type,mandatory,error)
       if (error)  return
       call cubetools_getarg(line,spafra%opt,2,user%equinox,.not.mandatory,error)
       if (error)  return
    endif
  end subroutine cubetools_spafra_parse
  !
  subroutine cubetools_spafra_user2prog(spafra,user,prog,error)
    use cubetools_header_interface
    use cubetools_user2prog
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Resolves a spatial frame description based on a previous one
    ! according to user inputs
    !----------------------------------------------------------------------
    class(spafra_opt_t), intent(in)    :: spafra
    type(spafra_user_t), intent(in)    :: user
    type(spafra_t),      intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    type(unit_user_t) :: nounit
    integer(kind=code_k) :: previous,default
    real(kind=equi_k) :: def,prev
    character(len=*), parameter :: rname='SPAFRA>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       previous = prog%code
       default = prog%code
       call cubetools_user2prog_resolve_code(spafra%type_arg,user%type,default,previous,prog%code,error)
       if (error) return
       if (prog%code.eq.code_spaframe_equatorial) then ! get equinox
          call cubetools_unit_get(strg_star,code_unit_unk,nounit,error)
          if (error) return
          def = 2000.0
          prev = prog%equinox
          call cubetools_user2prog_resolve_all(user%equinox,nounit,def,prev,prog%equinox,error)
          if (error) return
       endif
    endif
  end subroutine cubetools_spafra_user2prog
  !
  subroutine cubetools_spafra_prog2user(prog,user,error)
    use cubetools_header_interface
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(spafra_t),      intent(in)    :: prog
    type(spafra_user_t), intent(out)   :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    write(user%equinox,'(f8.1)') prog%equinox
    user%type = spaframes(prog%code)
  end subroutine cubetools_spafra_prog2user
  !
  subroutine cubetools_spafra_sicdef_user(name,user,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),    intent(in)    :: name
    type(spafra_user_t), intent(in)    :: user
    logical,             intent(in)    :: readonly
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>SICDEF>USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_charn(trim(name)//'%type',user%type,0,0,readonly,error)
    if (error)  return
    call sic_def_charn(trim(name)//'%epoch',user%equinox,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spafra_sicdef_user
  !
  subroutine cubetoools_spafra_spafra2userstruct(prog,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Transforms a prog type into an user type and loads it onto a
    ! user structure
    ! ------------------------------------------------------------------------
    type(spafra_t),     intent(in)    :: prog
    class(userspace_t), intent(inout) :: userstruct
    logical,            intent(inout) :: error
    !
    type(spafra_user_t) :: user
    character(len=*), parameter :: rname='SPAFRA>SPAFRA2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(userstruct)
    type is(userstruct_t)
       call cubetools_spafra_prog2user(prog,user,error)
       if (error) return
       call userstruct%def(error)
       if (error) return
       call userstruct%set_member('type',user%type,error)
       if (error) return
       call userstruct%set_member('epoch',user%equinox,error)
       if (error) return
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetoools_spafra_spafra2userstruct
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_spafra_sicdef(name,spafra,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Point a SIC structure onto an instance of the spafra_t type
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(spafra_t),   intent(in)    :: spafra
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>SICDEF'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_inte(trim(name)//'%code',spafra%code,0,0,readonly,error)
    if (error)  return
    call sic_def_real(trim(name)//'%equinox',spafra%equinox,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spafra_sicdef
  !
  subroutine cubetools_spafra_copy(in,ou,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spafra_t), intent(in)    :: in
    type(spafra_t), intent(out)   :: ou
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAFRA>COPY'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ou = in
  end subroutine cubetools_spafra_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_spafra_consistency_init(cons,error)
    !-------------------------------------------------------------------
    ! Init the consistency between two spatial frames
    !-------------------------------------------------------------------
    type(spafra_cons_t), intent(out)   :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPATIAL>SPAFRA>CONSISTENCY>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_init(notol,check,mess,cons%code,error)
    if (error) return
    call cubetools_consistency_init(strict,check,mess,cons%equinox,error)
    if (error) return
  end subroutine cubetools_spafra_consistency_init
  !
  subroutine cubetools_spafra_consistency_check(cons,spafra1,spafra2,error)
    use cubetools_header_interface
    !-------------------------------------------------------------------
    ! Check the consistency between two spatial frames
    !-------------------------------------------------------------------
    type(spafra_cons_t), intent(inout) :: cons
    type(spafra_t),      intent(in)    :: spafra1
    type(spafra_t),      intent(in)    :: spafra2
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPATIAL>SPAFRA>CONSISTENCY>CHECK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .false.
    call cubetools_consistency_integer_check(cons%code,spafra1%code,spafra2%code,error)
    if (error) return
    if ((spafra2%code.eq.code_spaframe_equatorial).and.(spafra1%code.eq.code_spaframe_equatorial)) then
       call cubetools_consistency_real_check(cons%equinox,spafra1%equinox,spafra2%equinox,error)
       if (error) return
    endif
    cons%prob = cons%code%prob.or.cons%equinox%prob
  end subroutine cubetools_spafra_consistency_check
  !
  subroutine cubetools_spafra_consistency_print(cons,spafra1,spafra2,error)
    use cubetools_header_interface
    !-------------------------------------------------------------------
    ! Print the consistency between two spatial frames
    !-------------------------------------------------------------------
    type(spafra_cons_t), intent(in)    :: cons
    type(spafra_t),      intent(in)    :: spafra1
    type(spafra_t),      intent(in)    :: spafra2
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPATIAL>SPAFRA>CONSISTENCY>PRINT'
    character(len=fram_l) :: fram1, fram2
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('spatial frames',3,cons%check,cons%prob,error)
    if(error) return
    if (cons%check.and.cons%prob) then
       call cubetools_convert_code2spaframe(spafra1%code,fram1,error)
       if (error) return
       call cubetools_convert_code2spaframe(spafra2%code,fram2,error)
       if (error) return
       call cubetools_consistency_string_print('Frames',cons%code,fram1,fram2,error)
       if (error) return
       if ((spafra2%code.eq.code_spaframe_equatorial).and.(spafra1%code.eq.code_spaframe_equatorial)) then
          call cubetools_consistency_real_print('Equinoxes',cons%equinox,spafra1%equinox,spafra2%equinox,error)
          if (error) return
       endif
    endif
    call cubetools_message(seve%r,rname,'')
  end subroutine cubetools_spafra_consistency_print
  !
  subroutine cubetools_spafra_consistency_final(cons,error)
    !-------------------------------------------------------------------
    ! Final the consistency between two spatial frames
    !-------------------------------------------------------------------
    type(spafra_cons_t), intent(out)   :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPATIAL>SPAFRA>CONSISTENCY>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%code,error)
    if (error) return
    call cubetools_consistency_final(cons%equinox,error)
    if (error) return
  end subroutine cubetools_spafra_consistency_final
end module cubetools_spafra_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
