!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_spapro_types
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_consistency_types
  use cubetools_structure
  use cubetools_keyword_arg
  !
  public :: spapro_t,spapro_cons_t
  !
  public :: spapro_type_opt_t,spapro_type_user_t
  public :: cubetools_spapro_type2uservar
  !
  public :: spapro_center_opt_t,spapro_center_user_t
  public :: cubetools_spapro_center2userstruct
  !
  public :: spapro_angle_opt_t,spapro_angle_user_t
  public :: cubetools_spapro_angle2userstruct
  !
  public :: cubetools_spapro_init,cubetools_spapro_put_and_derive
  public :: cubetools_spapro_final,cubetools_spapro_get
  public :: cubetools_spapro_list
  public :: cubetools_spapro_sicdef,cubetools_spapro_copy
  public :: cubetools_spapro_consistency_init,cubetools_spapro_consistency_final
  public :: cubetools_spapro_consistency_check,cubetools_spapro_consistency_print
  public :: cubetools_spapro_consistency_set_tol
  public :: cubetools_spapro_gwcs
  private
  !
  type spapro_t
     integer(kind=code_k) :: code = code_unk ! [---] Projection code
     real(kind=coor_k)    :: l0 = 0d0        ! [rad] Projection center
     real(kind=coor_k)    :: m0 = 0d0        ! [rad] Projection center
     real(kind=coor_k)    :: pa = 0d0        ! [rad] Projection position angle
  end type spapro_t
  !
  type spapro_type_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: arg
   contains
     procedure :: register  => cubetools_spapro_type_register
     procedure :: parse     => cubetools_spapro_type_parse
     procedure :: user2prog => cubetools_spapro_type_user2prog
  end type spapro_type_opt_t
  !
  type spapro_type_user_t
     character(len=argu_l) :: type  = strg_unk ! Projection type
     logical               :: do    = .false.  ! Option was present
  end type spapro_type_user_t
  !
  type spapro_center_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: type
   contains
     procedure :: register  => cubetools_spapro_center_register
     procedure :: parse     => cubetools_spapro_center_parse
     procedure :: user2prog => cubetools_spapro_center_user2prog
  end type spapro_center_opt_t
  !
  type spapro_center_user_t
     character(len=argu_l) :: l0    = strg_unk ! [RA |LII] Projection center
     character(len=argu_l) :: m0    = strg_unk ! [DEC|BII] Projection center
     character(len=argu_l) :: type  = strg_unk ! RELATIVE|ABSOLUTE center is absolute or relative
     character(len=argu_l) :: unit  = strg_unk ! Center unit, context dependent
     logical               :: do    = .false.  ! Option was present
  end type spapro_center_user_t
  !
  type spapro_angle_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: unit
   contains
     procedure :: register  => cubetools_spapro_angle_register
     procedure :: parse     => cubetools_spapro_angle_parse
     procedure :: user2prog => cubetools_spapro_angle_user2prog
  end type spapro_angle_opt_t
  !
  type spapro_angle_user_t
     character(len=argu_l) :: pa    = strg_unk ! Projection angle
     character(len=argu_l) :: unit  = strg_unk ! Projection angle unit
     logical               :: do    = .false.  ! Option was present
  end type spapro_angle_user_t
  !  
  type spapro_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) :: l0
     type(consistency_desc_t) :: m0
     type(consistency_desc_t) :: pa
  end type spapro_cons_t
  !
contains
  !
  subroutine cubetools_spapro_init(spapro,error)
    !-------------------------------------------------------------------
    ! Just initialize the type, ie, it is intent(out)
    !-------------------------------------------------------------------
    type(spapro_t), intent(out)   :: spapro
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_spapro_init
  !
  subroutine cubetools_spapro_put_and_derive(code,l0,m0,pa,spapro,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: code
    real(kind=coor_k),    intent(in)    :: l0
    real(kind=coor_k),    intent(in)    :: m0
    real(kind=coor_k),    intent(in)    :: pa
    type(spapro_t),       intent(inout) :: spapro
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>PUT>AND>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    spapro%code = code
    spapro%l0 = l0
    spapro%m0 = m0
    spapro%pa = pa
  end subroutine cubetools_spapro_put_and_derive
  !
  subroutine cubetools_spapro_get(spapro,code,l0,m0,pa,error)
    !-------------------------------------------------------------------
    ! system is not put here on purpose as this is a pointer.
    !-------------------------------------------------------------------
    type(spapro_t),       intent(in)    :: spapro
    integer(kind=code_k), intent(out)   :: code
    real(kind=coor_k),    intent(out)   :: l0
    real(kind=coor_k),    intent(out)   :: m0
    real(kind=coor_k),    intent(out)   :: pa
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>GET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    code = spapro%code
    l0 = spapro%l0
    m0 = spapro%m0
    pa = spapro%pa
  end subroutine cubetools_spapro_get
  !
  subroutine cubetools_spapro_final(spapro,error)
    !-------------------------------------------------------------------
    ! Just reinitialize the type, ie, it is intent(out)
    !-------------------------------------------------------------------
    type(spapro_t), intent(out)   :: spapro
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
  end subroutine cubetools_spapro_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_spapro_list(source,spafra,spapro,error)
    use phys_const
    use gbl_constant
    use gkernel_interfaces
    use cubetools_header_interface
    use cubetools_spafra_types
    use cubetools_format
    use cubetools_unit
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: source
    type(spafra_t),   intent(in)    :: spafra
    type(spapro_t),   intent(in)    :: spapro
    logical,          intent(inout) :: error
    !
    integer(kind=code_k) :: code
    real(kind=coor_k) :: l0degr,m0degr
    character(len=15) :: l0sexa,m0sexa
    character(len=fram_l) :: frame
    character(len=argu_l) :: projections(0:mproj)
    character(len=mess_l) :: mess
    type(unit_user_t) :: unitpang
    character(len=*), parameter :: rname='SPAPRO>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! source name and spatial frame
    call cubetools_convert_code2spaframe(spafra%code,frame,error)
    if (error) return
    call cubetools_unit_get(strg_star,code_unit_pang,unitpang,error)
    if (error) return
    mess = cubetools_format_stdkey_boldval('Source',source,22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Frame',frame,22)
    if (spafra%code.eq.code_spaframe_equatorial) then
       mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Eq',spafra%equinox,'f7.2',10)
    endif
    call cubetools_message(seve%r,rname,mess)
    ! Frame of reference
    code = spafra%code
    if ((code.eq.code_spaframe_equatorial).or.(code.eq.code_spaframe_icrs)) then
       call rad2sexa(spapro%l0,24,l0sexa)
       call rad2sexa(spapro%m0,360,m0sexa)
       mess = cubetools_format_stdkey_boldval('L0',l0sexa,22)
       mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('M0',m0sexa,22)
       mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('PA',spapro%pa*unitpang%user_per_prog,'f7.2',10)
    else ! Galactic | Horizonthal | unknown
       l0degr = spapro%l0*deg_per_rad
       m0degr = spapro%m0*deg_per_rad
       mess = cubetools_format_stdkey_boldval('L0',l0degr,'f18.13',22)
       mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('M0',m0degr,'f18.13',22)
       mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('PA',spapro%pa*unitpang%user_per_prog,'f7.2',10)
    endif
    call projnam_list(projections)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Pr',projections(spapro%code),12)
    call cubetools_message(seve%r,rname,mess)
  end subroutine cubetools_spapro_list
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_spapro_type_register(type,name,abstract,error)
    use gkernel_interfaces
    use gbl_constant
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Register /PTYPE option under a given name and abstract
    !----------------------------------------------------------------------
    class(spapro_type_opt_t), intent(out)   :: type
    character(len=*),         intent(in)    :: name
    character(len=*),         intent(in)    :: abstract
    logical,                  intent(inout) :: error
    !
    type(keyword_arg_t)  :: keyarg
    character(len=argu_l)  :: projections(0:mproj)
    character(len=*), parameter :: rname='SPAPRO>TYPE>REGISTER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call projnam_list(projections)
    call cubetools_register_option(&
         name,'type',&
         abstract,&
         strg_id,&
         type%opt,error)
    if (error) return
    call keyarg%register( &
         'type',  &
         'Projection type', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         projections(1:mproj),  &
         .not.flexible,  &
         type%arg,  &
         error)
    if (error) return
  end subroutine cubetools_spapro_type_register
  !
  subroutine cubetools_spapro_type_parse(type,line,user,error)
    !----------------------------------------------------------------------
    ! /PTYPE type 
    ! ----------------------------------------------------------------------
    class(spapro_type_opt_t), intent(in)    :: type
    character(len=*),         intent(in)    :: line
    type(spapro_type_user_t), intent(out)   :: user
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>TYPE>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%type = strg_star
    !
    call type%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,type%opt,1,user%type,mandatory,error)
       if (error)  return
    endif
  end subroutine cubetools_spapro_type_parse
  !
  subroutine cubetools_spapro_type_user2prog(type,user,prog,error)
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! Resolves a projection type
    !----------------------------------------------------------------------
    class(spapro_type_opt_t), intent(in)    :: type
    type(spapro_type_user_t), intent(in)    :: user
    type(spapro_t),           intent(inout) :: prog
    logical,                  intent(inout) :: error
    !
    integer(kind=code_k) :: prev,def
    character(len=*), parameter :: rname='SPAPRO>TYPE>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       if (user%type.eq.strg_unk) then
          prog%code = code_unk
       else
          def = prog%code
          prev = prog%code
          call cubetools_user2prog_resolve_code(type%arg,user%type,def,prev,prog%code,error)
          if (error) return
       endif
    else
       ! Spapro_t from header is not modified
    endif
  end subroutine cubetools_spapro_type_user2prog
  !
  subroutine cubetools_spapro_type_prog2user(prog,user,error)
    use gkernel_interfaces
    use gbl_constant
    !----------------------------------------------------------------------
    ! Fills a spapro_type_user_t with projection information
    !----------------------------------------------------------------------
    type(spapro_t),           intent(in)    :: prog
    type(spapro_type_user_t), intent(out)   :: user
    logical,                  intent(inout) :: error
    !
    character(len=argu_l)  :: projections(0:mproj)
    character(len=*), parameter :: rname='SPAPRO>TYPE>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call projnam_list(projections)
    user%type = projections(prog%code)
  end subroutine cubetools_spapro_type_prog2user
  !
  subroutine cubetools_spapro_type_sicdef_user(name,user,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),         intent(in)    :: name
    type(spapro_type_user_t), intent(in)    :: user
    logical,                  intent(in)    :: readonly
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>TYPE>SICDEF>USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_def_charn(trim(name),user%type,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spapro_type_sicdef_user
  !
  subroutine cubetools_spapro_type2uservar(prog,uservar,error)
    use cubetools_userspace
    use cubetools_uservar
    !----------------------------------------------------------------------
    ! loads a projection center onto a user variable
    !----------------------------------------------------------------------
    type(spapro_t),             intent(in)    :: prog
    class(userspace_t),         intent(inout) :: uservar
    logical,                    intent(inout) :: error
    !
    type(spapro_type_user_t) :: user
    character(len=*), parameter :: rname='SPAPRO>TYPE2USERVAR'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(uservar)
    type is (uservar_t)
       call cubetools_spapro_type_prog2user(prog,user,error)
       if (error) return
       call uservar%set(user%type,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 cubetools_spapro_type2uservar
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_spapro_center_register(center,name,abstract,error)
    !----------------------------------------------------------------------
    ! Register a /PCENTER option under a given name and abstract
    !----------------------------------------------------------------------
    class(spapro_center_opt_t), intent(out)   :: center
    character(len=*),           intent(in)    :: name
    character(len=*),           intent(in)    :: abstract
    logical,                    intent(inout) :: error
    !
    type(keyword_arg_t)  :: keyarg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: ctypes(2) = ['Absolute','Relative']
    character(len=*), parameter :: rname='SPAPRO>CENTER>REGISTER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'l0 m0 type [unit]',&
         abstract,&
         strg_id,&
         center%opt,error)
    if (error) return
    call stdarg%register( &
         'l0',  &
         'l Coordinate for projection center', &
          '"*" or "=" mean previous value is kept',&
          code_arg_mandatory, error)
    if (error) return
    call stdarg%register( &
         'm0',  &
         'm Coordinate for projection center', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         error)
    if (error) return
    call keyarg%register( &
         'type',  &
         'Coordinates type', &
         strg_id,&
         code_arg_mandatory, &
         ctypes,  &
         .not.flexible,  &
         center%type,  &
         error)
    if (error) return
    call stdarg%register( &
         'unit',  &
         'Unit for l0 and m0', &
         'Available units depend on center type: FOV units for&
         & relative;  equatorial, degrees or radians for absolute',&
         code_arg_optional, error)
    if (error) return
  end subroutine cubetools_spapro_center_register
  !
  subroutine cubetools_spapro_center_parse(center,line,user,error)
    !----------------------------------------------------------------------
    ! /PCENTER l0 m0 type [unit]
    ! ----------------------------------------------------------------------
    class(spapro_center_opt_t), intent(in)    :: center
    character(len=*),           intent(in)    :: line
    type(spapro_center_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>CENTER>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%l0   = strg_star
    user%m0   = strg_star
    user%type = strg_star
    user%unit = strg_star    
    !
    call center%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,center%opt,1,user%l0,mandatory,error)
       if (error)  return
       call cubetools_getarg(line,center%opt,2,user%m0,mandatory,error)
       if (error)  return
       call cubetools_getarg(line,center%opt,3,user%type,mandatory,error)
       if (error)  return
       call cubetools_getarg(line,center%opt,4,user%unit,.not.mandatory,error)
       if (error)  return
    endif
  end subroutine cubetools_spapro_center_parse
  !
  subroutine cubetools_spapro_center_user2prog(center,frame,user,prog,error)
    use cubetools_user2prog
    use cubetools_spafra_types
    !----------------------------------------------------------------------
    ! Resolves a projection center
    !----------------------------------------------------------------------
    class(spapro_center_opt_t), intent(in)    :: center
    type(spafra_t),             intent(in)    :: frame
    type(spapro_center_user_t), intent(in)    :: user
    type(spapro_t),             intent(inout) :: prog
    logical,                    intent(inout) :: error
    !
    integer(kind=4) :: ikey
    character(len=12) :: type
    character(len=*), parameter :: rname='SPAPRO>CENTER>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       call cubetools_keyword_user2prog(center%type,user%type,ikey,type,error)
       if (error)  return
       select case(type)
       case('ABSOLUTE')
          call cubetools_spapro_center_absolute_user2prog(frame,user,prog,error)
          if (error)  return
       case('RELATIVE')
          call cubetools_spapro_center_relative_user2prog(user,prog,error)
          if (error)  return
       end select
    else
       ! Spapro_t from header is not modified
    endif
  end subroutine cubetools_spapro_center_user2prog
  !
  subroutine cubetools_spapro_center_absolute_user2prog(frame,user,prog,error)
    use gkernel_interfaces
    use cubetools_user2prog
    use cubetools_spafra_types
    use cubetools_disambiguate
    use cubetools_unit
    use cubetools_header_interface
    !----------------------------------------------------------------------
    ! Resolves an absolute projection center
    !----------------------------------------------------------------------
    type(spafra_t),             intent(in)    :: frame
    type(spapro_center_user_t), intent(in)    :: user
    type(spapro_t),             intent(inout) :: prog
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: posunit
    character(len=unit_l) :: unit
    real(kind=coor_k) :: default,previous
    integer(kind=4) :: ikey
    character(len=*), parameter :: units(4)=[strg_star//'         ','Equatorial','Radian    ','Degree    ']
    character(len=*), parameter :: rname='SPAPRO>CENTER>ABSOLUTE>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_disambiguate_strict(user%unit,units,ikey,unit,error)
    if (error) return
    select case(unit)
    case(strg_star,'EQUATORIAL') ! Use sic_decode
       select case(frame%code)
       case(code_spaframe_equatorial,code_spaframe_icrs)
          call sic_decode(user%l0,prog%l0,24,error)
          if (error) return
       case (code_spaframe_galactic)
          call sic_decode(user%l0,prog%l0,360,error)
          if (error) return
       case default
          call cubetools_message(seve%e,rname,'Unknown spatial frame code')
          error = .true.
          return
       end select
       call sic_decode(user%m0,prog%m0,360,error)
       if (error) return
    case('RADIAN','DEGREE')
       ! Unit is Pang because we need either Radian or Degree
       call cubetools_unit_get(unit,code_unit_pang,posunit,error)
       if (error) return
       default = prog%l0
       previous = prog%l0
       call cubetools_user2prog_resolve_all(user%l0,posunit,default,previous,prog%l0,error)
       if (error) return
       default = prog%m0
       previous = prog%m0
       call cubetools_user2prog_resolve_all(user%m0,posunit,default,previous,prog%m0,error)
       if (error) return      
    end select
  end subroutine cubetools_spapro_center_absolute_user2prog
  !
  subroutine cubetools_spapro_center_relative_user2prog(user,prog,error)
    use gkernel_interfaces
    use gkernel_types
    use cubetools_user2prog
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Resolves a relative projection center
    !----------------------------------------------------------------------
    type(spapro_center_user_t), intent(in)    :: user
    type(spapro_t),             intent(inout) :: prog
    logical,                    intent(inout) :: error
    !
    type(unit_user_t) :: unit
    real(kind=coor_k) :: default,previous,lcoor,mcoor
    type(projection_t) :: gproj
    character(len=*), parameter :: rname='SPAPRO>CENTER>RELATIVE>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_unit_get(user%unit,code_unit_fov,unit,error)
    if (error) return
    default  = 0d0
    previous = 0d0
    call cubetools_user2prog_resolve_all(user%l0,unit,default,previous,lcoor,error)
    if (error) return
    call cubetools_user2prog_resolve_all(user%m0,unit,default,previous,mcoor,error)
    if (error) return
    !
    call cubetools_spapro_gwcs(prog,gproj,error)
    if(error) return
    call rel_to_abs(gproj,lcoor,mcoor,prog%l0,prog%m0,1)
  end subroutine cubetools_spapro_center_relative_user2prog
  !
  subroutine cubetools_spapro_center_prog2user(frame,prog,user,error)
    use gkernel_interfaces
    use cubetools_spafra_types
    use cubetools_header_interface
    !----------------------------------------------------------------------
    ! FIlls a spapro_center_user_t with projection info
    !----------------------------------------------------------------------
    type(spafra_t),             intent(in)    :: frame
    type(spapro_t),             intent(in)    :: prog
    type(spapro_center_user_t), intent(out)   :: user
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>CENTER>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%type = 'Absolute'
    user%unit = 'Equatorial'
    !
    select case(frame%code)
    case(code_spaframe_equatorial,code_spaframe_icrs)
       call rad2sexa(prog%l0,24,user%l0)
    case (code_spaframe_galactic)
       call rad2sexa(prog%l0,360,user%l0)
    case default
       call cubetools_message(seve%e,rname,'Unknown spatial frame code')
       error = .true.
       return
    end select
    call rad2sexa(prog%m0,360,user%m0)
    user%l0 = adjustl(user%l0)
    user%m0 = adjustl(user%m0)
  end subroutine cubetools_spapro_center_prog2user
  !
  subroutine cubetools_spapro_center_sicdef_user(name,user,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),           intent(in)    :: name
    type(spapro_center_user_t), intent(in)    :: user
    logical,                    intent(in)    :: readonly
    logical,                    intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>CENTER2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_charn(trim(name)//'%l0',user%l0,0,0,readonly,error)
    if (error)  return
    call sic_def_charn(trim(name)//'%m0',user%m0,0,0,readonly,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)//'%unit',user%unit,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spapro_center_sicdef_user
  !
  subroutine cubetools_spapro_center2userstruct(frame,prog,userstruct,error)
    use cubetools_spafra_types
    use cubetools_userspace
    use cubetools_userstruct
    !----------------------------------------------------------------------
    ! loads a projection center onto a user structure
    !----------------------------------------------------------------------
    type(spafra_t),             intent(in)    :: frame
    type(spapro_t),             intent(in)    :: prog
    class(userspace_t),         intent(inout) :: userstruct
    logical,                    intent(inout) :: error
    !
    type(spapro_center_user_t) :: user
    character(len=*), parameter :: rname='SPAPRO>CENTER>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(userstruct)
    type is (userstruct_t)
       call cubetools_spapro_center_prog2user(frame,prog,user,error)
       if (error) return
       call userstruct%def(error)
       if (error) return
       call userstruct%set_member('l0',user%l0,error)
       if (error) return
       call userstruct%set_member('m0',user%m0,error)
       if (error) return
       call userstruct%set_member('type',user%type,error)
       if (error) return
       call userstruct%set_member('unit',user%unit,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 cubetools_spapro_center2userstruct
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_spapro_angle_register(angle,name,abstract,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Register a /PANGLE option under a given name and abstract
    !----------------------------------------------------------------------
    class(spapro_angle_opt_t), intent(out)   :: angle
    character(len=*),          intent(in)    :: name
    character(len=*),          intent(in)    :: abstract
    logical,                   intent(inout) :: error
    !
    type(keyword_arg_t)  :: keyarg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='SPAPRO>ANGLE>REGISTER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'pang [paunit]',&
         abstract,&
         strg_id,&
         angle%opt,error)
    if (error) return
    call stdarg%register( &
         'pang',  &
         'Projection position angle', &
         '"*" or "=" mean previous value is kept',&
         code_arg_optional, &
         error)
    if (error) return
    call keyarg%register( &
         'paunit',  &
         'Position angle unit', &
         '"*" or "=" mean previous value is kept',&
         code_arg_optional, &
         unit_pang_name, &
         .not.flexible, &
         angle%unit,&
         error)
    if (error) return
  end subroutine cubetools_spapro_angle_register
  !
  subroutine cubetools_spapro_angle_parse(angle,line,user,error)
    !----------------------------------------------------------------------
    ! /PANGLE pang [unit]
    ! ----------------------------------------------------------------------
    class(spapro_angle_opt_t), intent(in)    :: angle
    character(len=*),          intent(in)    :: line
    type(spapro_angle_user_t), intent(out)   :: user
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>ANGLE>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%pa   = strg_star
    user%unit = strg_star    
    !
    call angle%opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,angle%opt,1,user%pa,mandatory,error)
       if (error)  return
       call cubetools_getarg(line,angle%opt,2,user%unit,.not.mandatory,error)
       if (error)  return
    endif
  end subroutine cubetools_spapro_angle_parse
  !
  subroutine cubetools_spapro_angle_user2prog(angle,user,prog,error)
    use gbl_constant
    use cubetools_unit
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! Resolves projection angles
    !----------------------------------------------------------------------
    class(spapro_angle_opt_t), intent(in)    :: angle
    type(spapro_angle_user_t), intent(in)    :: user
    type(spapro_t),            intent(inout) :: prog
    logical,                   intent(inout) :: error
    !
    type(unit_user_t) :: unitpang
    real(kind=coor_k) :: default,previous
    character(len=*), parameter :: rname='SPAPRO>ANGLE>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       call cubetools_unit_get(user%unit,code_unit_pang,unitpang,error)
       if (error) return
       default = prog%pa
       previous = prog%pa
       call cubetools_user2prog_resolve_all(user%pa,unitpang,default,previous,prog%pa,error)
       if (error) return
       !
       if (prog%pa.ne.0.d0 .and. &
            (prog%code.eq.p_radio .or. prog%code.eq.p_aitoff)) then
          call cubetools_message(seve%e,rname,'Angle not supported in projection RADIO or AITOFF')
          call cubetools_message(seve%e,rname,'Projection AZIMUTHAL can be prefered instead')
          error = .true.
          return
       endif
    else
       ! Spapro_t from header is not modified
    endif
  end subroutine cubetools_spapro_angle_user2prog
  !
  subroutine cubetools_spapro_angle_prog2user(prog,user,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    ! fills a spapro_angle_user_t with projection info
    !----------------------------------------------------------------------
    type(spapro_t),            intent(in)    :: prog
    type(spapro_angle_user_t), intent(out)   :: user
    logical,                   intent(inout) :: error
    !
    type(unit_user_t) :: unit
    character(len=*), parameter :: rname='SPAPRO>ANGLE>PROG2USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_unit_get(strg_star,code_unit_pang,unit,error)
    if (error) return
    user%unit = unit%name
    write(user%pa,'(1pg14.7)') prog%pa*unit%user_per_prog
  end subroutine cubetools_spapro_angle_prog2user
  !
  subroutine cubetools_spapro_angle_sicdef_user(name,user,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),          intent(in)    :: name
    type(spapro_angle_user_t), intent(in)    :: user
    logical,                   intent(in)    :: readonly
    logical,                   intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>ANGLE>SICDEF>USER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_charn(trim(name)//'%pang',user%pa,0,0,readonly,error)
    if (error)  return
    call sic_def_charn(trim(name)//'%paunit',user%unit,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spapro_angle_sicdef_user
  !
  subroutine cubetools_spapro_angle2userstruct(prog,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !----------------------------------------------------------------------
    ! Loads projection angle onto a userstructure
    !----------------------------------------------------------------------
    type(spapro_t),             intent(in)    :: prog
    class(userspace_t),         intent(inout) :: userstruct
    logical,                    intent(inout) :: error
    !
    type(spapro_angle_user_t) :: user
    character(len=*), parameter :: rname='SPAPRO>ANGLE2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    select type(userstruct)
    type is (userstruct_t)
       call cubetools_spapro_angle_prog2user(prog,user,error)
       if (error) return
       call userstruct%def(error)
       if (error) return
       call userstruct%set_member('pang',user%pa,error)
       if (error) return
       call userstruct%set_member('paunit',user%unit,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 cubetools_spapro_angle2userstruct
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_spapro_sicdef(name,spapro,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Point a SIC structure onto an instance of the spapro_t type
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(spapro_t),   intent(in)    :: spapro
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>SICDEF'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_inte(trim(name)//'%code',spapro%code,0,0,readonly,error)
    if (error)  return
    call sic_def_dble(trim(name)//'%l0',spapro%l0,0,0,readonly,error)
    if (error)  return
    call sic_def_dble(trim(name)//'%m0',spapro%m0,0,0,readonly,error)
    if (error)  return
    call sic_def_dble(trim(name)//'%pa',spapro%pa,0,0,readonly,error)
    if (error)  return
  end subroutine cubetools_spapro_sicdef
  !
  subroutine cubetools_spapro_copy(in,ou,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spapro_t), intent(in)    :: in
    type(spapro_t), intent(out)   :: ou
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>COPY'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ou = in
  end subroutine cubetools_spapro_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_spapro_consistency_init(cons,error)
    !-------------------------------------------------------------------
    ! Init the consistency between two spatial promes
    !-------------------------------------------------------------------
    type(spapro_cons_t), intent(out)   :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPATIAL>SPAPRO>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(tenper,check,mess,cons%l0,error)
    if (error) return
    call cubetools_consistency_init(tenper,check,mess,cons%m0,error)
    if (error) return
    call cubetools_consistency_init(tenper,check,mess,cons%pa,error)
    if (error) return
  end subroutine cubetools_spapro_consistency_init
  !
  subroutine cubetools_spapro_consistency_set_tol(protol,cons,error)
    !-------------------------------------------------------------------
    ! Set the tolerance for projection consistency check
    !-------------------------------------------------------------------
    real(kind=tole_k),   intent(in)    :: protol
    type(spapro_cons_t), intent(inout) :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>CONSISTENCY>SET>TOL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    cons%l0%tol = protol
    cons%m0%tol = protol
    cons%pa%tol = protol
  end subroutine cubetools_spapro_consistency_set_tol
  !
  subroutine cubetools_spapro_consistency_check(cons,frame1,incl1,incm1,spapro1,&
       frame2,incl2,incm2,spapro2,error)
    use gbl_constant
    use gkernel_interfaces
    use cubetools_convert
    use cubetools_spafra_types
    !-------------------------------------------------------------------
    ! Check the consistency between two spatial promes
    !-------------------------------------------------------------------
    type(spapro_cons_t), intent(inout) :: cons
    type(spafra_t),      intent(in)    :: frame1
    real(kind=coor_k),   intent(in)    :: incl1
    real(kind=coor_k),   intent(in)    :: incm1
    type(spapro_t),      intent(in)    :: spapro1
    type(spafra_t),      intent(in)    :: frame2
    real(kind=coor_k),   intent(in)    :: incl2
    real(kind=coor_k),   intent(in)    :: incm2
    type(spapro_t),      intent(in)    :: spapro2
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>CONSISTENCY>CHECK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .false.
    call cubetools_consistency_integer_check(cons%code,spapro1%code,spapro2%code,error)
    if (error) return
    call cubetools_consistency_real_relative_check(cons%l0,incl1,spapro1%l0,incl2,spapro2%l0,error)
    if (error) return
    call cubetools_consistency_real_relative_check(cons%m0,incm1,spapro1%m0,incm2,spapro2%m0,error)
    if (error) return
    call cubetools_consistency_angle_check(cons%pa,spapro1%pa,spapro2%pa,error)
    if (error) return
    !
    cons%prob = cons%code%prob.or.cons%l0%prob.or.cons%m0%prob.or.cons%pa%prob
  end subroutine cubetools_spapro_consistency_check
    !
  subroutine cubetools_spapro_consistency_print(cons,frame1,spapro1,&
       frame2,spapro2,error)
    use gbl_constant
    use gkernel_interfaces
    use cubetools_header_interface
    use cubetools_spafra_types
    use cubetools_unit
    !-------------------------------------------------------------------
    ! Print the consistency between two spatial promes
    !-------------------------------------------------------------------
    type(spapro_cons_t), intent(in)    :: cons
    type(spafra_t),      intent(in)    :: frame1
    type(spapro_t),      intent(in)    :: spapro1
    type(spafra_t),      intent(in)    :: frame2
    type(spapro_t),      intent(in)    :: spapro2
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>CONSISTENCY>PRINT'
    character(len=sexa_l) :: l01,l02,m01,m02
    character(len=argu_l)  :: projections(0:mproj),proj1,proj2
    type(unit_user_t) :: unitpang
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title('projections',3,cons%check,cons%prob,error)
    if(error) return
    if (cons%check.and.cons%prob) then
       call projnam_list(projections)
       if (spapro1%code.eq.code_unk) then
          proj1 = strg_unk
       else
          proj1 = projections(spapro1%code)
       endif
       if (spapro2%code.eq.code_unk) then
          proj2 = strg_unk
       else
          proj2 = projections(spapro2%code)
       endif
       call cubetools_consistency_string_print('Proj. Systems',cons%code,proj1,proj2,error)
       if (error) return
       if (frame1%code.ne.code_spaframe_galactic) then
          call rad2sexa(spapro1%l0,24,l01)
       else
          call rad2sexa(spapro1%l0,360,l01)
       endif
       if (frame2%code.ne.code_spaframe_galactic) then
          call rad2sexa(spapro2%l0,24,l02)
       else
          call rad2sexa(spapro2%l0,360,l02)
       endif
       call cubetools_consistency_string_print('L0 Center',cons%l0,l01,l02,error)
       if (error) return
       call rad2sexa(spapro1%m0,360,m01)
       call rad2sexa(spapro2%m0,360,m02)
       call cubetools_consistency_string_print('M0 Center',cons%m0,m01,m02,error)
       if (error) return
       !
       call cubetools_unit_get(strg_star,code_unit_pang,unitpang,error)
       if (error) return
       call cubetools_consistency_real_print('Proj. Angles',unitpang%name,cons%pa,&
            spapro1%pa*unitpang%user_per_prog,spapro2%pa*unitpang%user_per_prog,error)
       if (error) return
    endif
    call cubetools_message(seve%r,rname,'')
  end subroutine cubetools_spapro_consistency_print
  !
  subroutine cubetools_spapro_consistency_final(cons,error)
    !-------------------------------------------------------------------
    ! Final the consistency between two spatial promes
    !-------------------------------------------------------------------
    type(spapro_cons_t), intent(out)   :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>CONSISTENCY>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%code,error)
    if (error) return
    call cubetools_consistency_final(cons%l0,error)
    if (error) return
    call cubetools_consistency_final(cons%m0,error)
    if (error) return
    call cubetools_consistency_final(cons%pa,error)
    if (error) return
  end subroutine cubetools_spapro_consistency_final
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_spapro_gwcs(spapro,gproj,error)
    use gkernel_types
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Puts a projection description into a kernel projection type
    !----------------------------------------------------------------------
    type(spapro_t),    intent(in)    :: spapro
    type(projection_t),intent(out)   :: gproj
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPRO>GWCS'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call gwcs_projec(spapro%l0,spapro%m0,spapro%pa,spapro%code,gproj,error)
    if (error) return
  end subroutine cubetools_spapro_gwcs
end module cubetools_spapro_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
