subroutine equ_to_gal(ra,dec,raoff,decoff,equinox,l,b,loff,boff,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>equ_to_gal
  !---------------------------------------------------------------------
  ! @ public
  !  Convert 1 position + 1 offset from Equatorial+Equinox to Galactic
  !---------------------------------------------------------------------
  real(kind=8), intent(in)    :: ra       !
  real(kind=8), intent(in)    :: dec      !
  real(kind=4), intent(in)    :: raoff    !
  real(kind=4), intent(in)    :: decoff   !
  real(kind=4), intent(in)    :: equinox  !
  real(kind=8), intent(out)   :: l        !
  real(kind=8), intent(out)   :: b        !
  real(kind=4), intent(out)   :: loff     !
  real(kind=4), intent(out)   :: boff     !
  logical,      intent(inout) :: error    !
  ! Local
  real(kind=8) :: oldcoord(2),incoord(2),outcoord(2),matrix(3,3)
  real(kind=4) :: oldin,oldout,inoff(2),outoff(2)
  save oldin,oldout,matrix,oldcoord,outcoord
  ! Data
  data oldin/0.0/, oldout/-1.0/
  !
  if (equinox.eq.equinox_null) then
    call gwcs_message(seve%e,'SYSTEM',  &
      'Cannot convert from EQUATORIAL with unknown Equinox to GALACTIC')
    error = .true.
    return
  endif
  !
  incoord(1) = ra
  incoord(2) = dec
  inoff(1) = raoff
  inoff(2) = decoff
  if (oldin.ne.equinox .or. oldout.ne.0.0) then
    call chgcoo ('EQ','GA',equinox,0.0,matrix)
    oldin = equinox
    oldout = 0.0
    call chgref (matrix,incoord,outcoord)
  elseif (incoord(1).ne.oldcoord(1) .or. incoord(2).ne.oldcoord(2)) then
    call chgref (matrix,incoord,outcoord)
  endif
  oldcoord(1) = incoord(1)
  oldcoord(2) = incoord(2)
  if (inoff(1).ne.0.0 .or. inoff(2).ne.0.0) then
    call chgoff (matrix,incoord,inoff,outcoord,outoff)
  else
    outoff(1)=0.0
    outoff(2)=0.0
  endif
  l = outcoord(1)
  b = outcoord(2)
  loff = outoff(1)
  boff = outoff(2)
end subroutine equ_to_gal
!
subroutine equ_gal_0d(ra,dec,equinox,l,b,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>equ_gal_0d
  !---------------------------------------------------------------------
  ! @ public-generic equ_gal
  !  Convert 1 position from Equatorial+Equinox to Galactic
  !  Scalar version
  !---------------------------------------------------------------------
  real(kind=8),    intent(in)    :: ra       !
  real(kind=8),    intent(in)    :: dec      !
  real(kind=4),    intent(in)    :: equinox  !
  real(kind=8),    intent(out)   :: l        !
  real(kind=8),    intent(out)   :: b        !
  logical,         intent(inout) :: error    !
  ! Local
  real(kind=8) :: ra1(1),dec1(1),l1(1),b1(1)
  !
  ra1(1) = ra
  dec1(1) = dec
  call equ_gal_1d(ra1,dec1,equinox,l1,b1,1,error)
  if (error)  return
  l = l1(1)
  b = b1(1)
  !
end subroutine equ_gal_0d
!
subroutine equ_gal_1d(ra,dec,equinox,l,b,n,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>equ_gal_1d
  !---------------------------------------------------------------------
  ! @ public-generic equ_gal
  !  Convert 1 position from Equatorial+Equinox to Galactic
  !  1D-array version
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: n         !
  real(kind=8),    intent(in)    :: ra(n)     !
  real(kind=8),    intent(in)    :: dec(n)    !
  real(kind=4),    intent(in)    :: equinox   !
  real(kind=8),    intent(out)   :: l(n)      !
  real(kind=8),    intent(out)   :: b(n)      !
  logical,         intent(inout) :: error     !
  ! Local
  integer(kind=4) :: i
  real(kind=8) :: in(2),out(2),matrix(3,3)
  !
  if (equinox.eq.equinox_null) then
    call gwcs_message(seve%e,'SYSTEM',  &
      'Cannot convert from EQUATORIAL with unknown Equinox to GALACTIC')
    error = .true.
    return
  endif
  !
  call chgcoo ('EQ','GA',equinox,0.0,matrix)
  do i=1,n
    in(1) = ra(i)
    in(2) = dec(i)
    call chgref (matrix,in,out)
    l(i) = out(1)
    b(i) = out(2)
  enddo
end subroutine equ_gal_1d
!
subroutine equ_gal_2d(ra,dec,equinox,l,b,n,m,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>equ_gal_2d
  !---------------------------------------------------------------------
  ! @ public-generic equ_gal
  !  Convert 1 position from Equatorial+Equinox to Galactic
  !  2D-array version
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: n,m       !
  real(kind=8),    intent(in)    :: ra(n,m)   !
  real(kind=8),    intent(in)    :: dec(n,m)  !
  real(kind=4),    intent(in)    :: equinox   !
  real(kind=8),    intent(out)   :: l(n,m)    !
  real(kind=8),    intent(out)   :: b(n,m)    !
  logical,         intent(inout) :: error     !
  !
  call equ_gal_1d(ra,dec,equinox,l,b,n*m,error)
  !
end subroutine equ_gal_2d
!
subroutine gal_to_equ(l,b,loff,boff,ra,dec,raoff,decoff,equinox,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>gal_to_equ
  !---------------------------------------------------------------------
  ! @ public
  !  Convert 1 position + 1 offset from Galactic to Equatorial+Equinox
  !---------------------------------------------------------------------
  real(kind=8), intent(in)    :: l        !
  real(kind=8), intent(in)    :: b        !
  real(kind=4), intent(in)    :: loff     !
  real(kind=4), intent(in)    :: boff     !
  real(kind=8), intent(out)   :: ra       !
  real(kind=8), intent(out)   :: dec      !
  real(kind=4), intent(out)   :: raoff    !
  real(kind=4), intent(out)   :: decoff   !
  real(kind=4), intent(in)    :: equinox  !
  logical,      intent(inout) :: error    !
  ! Local
  real(kind=8) :: oldcoord(2),incoord(2),outcoord(2),matrix(3,3)
  real(kind=4) :: oldin,oldout,inoff(2),outoff(2)
  save oldin,oldout,matrix,oldcoord,outcoord
  ! Data
  data oldin/0.0/, oldout/-1.0/
  !
  if (equinox.eq.equinox_null) then
    call gwcs_message(seve%e,'SYSTEM',  &
      'Cannot convert from GALACTIC to EQUATORIAL with unknown Equinox')
    error = .true.
    return
  endif
  !
  incoord(1) = l
  incoord(2) = b
  inoff(1) = loff
  inoff(2) = boff
  if (oldin.ne.0.0 .or. oldout.ne.equinox) then
    call chgcoo ('GA','EQ',0.0,equinox,matrix)
    oldin = 0.0
    oldout = equinox
    call chgref (matrix,incoord,outcoord)
  elseif (incoord(1).ne.oldcoord(1) .or. incoord(2).ne.oldcoord(2)) then
    call chgref (matrix,incoord,outcoord)
  endif
  oldcoord(1) = incoord(1)
  oldcoord(2) = incoord(2)
  if (inoff(1).ne.0.0 .or. inoff(2).ne.0.0) then
    call chgoff (matrix,incoord,inoff,outcoord,outoff)
  else
    outoff(1)=0.0
    outoff(2)=0.0
  endif
  ra = outcoord(1)
  dec = outcoord(2)
  raoff = outoff(1)
  decoff = outoff(2)
end subroutine gal_to_equ
!
subroutine gal_equ_0d(l,b,ra,dec,equinox,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>gal_equ_0d
  !---------------------------------------------------------------------
  ! @ public-generic gal_equ
  !  Convert 1 position from Galactic to Equatorial+Equinox
  !  Scalar version
  !---------------------------------------------------------------------
  real(kind=8),    intent(in)    :: l        !
  real(kind=8),    intent(in)    :: b        !
  real(kind=8),    intent(out)   :: ra       !
  real(kind=8),    intent(out)   :: dec      !
  real(kind=4),    intent(in)    :: equinox  !
  logical,         intent(inout) :: error    !
  ! Local
  real(kind=8) :: l1(1),b1(1),ra1(1),dec1(1)
  !
  l1(1) = l
  b1(1) = b
  call gal_equ_1d(l1,b1,ra1,dec1,equinox,1,error)
  if (error)  return
  ra = ra1(1)
  dec = dec1(1)
end subroutine gal_equ_0d
!
subroutine gal_equ_1d(l,b,ra,dec,equinox,n,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>gal_equ_1d
  !---------------------------------------------------------------------
  ! @ public-generic gal_equ
  !  Convert 1 position from Galactic to Equatorial+Equinox
  !  1D-array version
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: n        !
  real(kind=8),    intent(in)    :: l(n)     !
  real(kind=8),    intent(in)    :: b(n)     !
  real(kind=8),    intent(out)   :: ra(n)    !
  real(kind=8),    intent(out)   :: dec(n)   !
  real(kind=4),    intent(in)    :: equinox  !
  logical,         intent(inout) :: error    !
  ! Local
  integer(kind=4) :: i
  real(kind=8) :: in(2),out(2),matrix(3,3)
  !
  if (equinox.eq.equinox_null) then
    call gwcs_message(seve%e,'SYSTEM',  &
      'Cannot convert from GALACTIC to EQUATORIAL with unknown Equinox')
    error = .true.
    return
  endif
  !
  call chgcoo('GA','EQ',0.0,equinox,matrix)
  do i=1,n
    in(1) = l(i)
    in(2) = b(i)
    call chgref (matrix,in,out)
    ra(i) = out(1)
    dec(i) = out(2)
  enddo
end subroutine gal_equ_1d
!
subroutine gal_equ_2d(l,b,ra,dec,equinox,n,m,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>gal_equ_2d
  !---------------------------------------------------------------------
  ! @ public-generic gal_equ
  !  Convert 1 position from Galactic to Equatorial+Equinox
  !  1D-array version
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: n,m       !
  real(kind=8),    intent(in)    :: l(n,m)    !
  real(kind=8),    intent(in)    :: b(n,m)    !
  real(kind=8),    intent(out)   :: ra(n,m)   !
  real(kind=8),    intent(out)   :: dec(n,m)  !
  real(kind=4),    intent(in)    :: equinox   !
  logical,         intent(inout) :: error     !
  !
  call gal_equ_1d(l,b,ra,dec,equinox,n*m,error)
  !
end subroutine gal_equ_2d
!
subroutine equ_to_equ(inra,indec,inroff,indoff,inequinox,ra,dec,  &
  raoff,decoff,equinox,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>equ_to_equ
  !---------------------------------------------------------------------
  ! @ public
  !  Convert 1 position + 1 offset from Equatorial+Equinox to
  ! Equatorial+Equinox
  !---------------------------------------------------------------------
  real(kind=8), intent(in)    :: inra       !
  real(kind=8), intent(in)    :: indec      !
  real(kind=4), intent(in)    :: inroff     !
  real(kind=4), intent(in)    :: indoff     !
  real(kind=4), intent(in)    :: inequinox  !
  real(kind=8), intent(out)   :: ra         !
  real(kind=8), intent(out)   :: dec        !
  real(kind=4), intent(out)   :: raoff      !
  real(kind=4), intent(out)   :: decoff     !
  real(kind=4), intent(in)    :: equinox    !
  logical,      intent(inout) :: error      !
  ! Local
  real(kind=8) :: oldcoord(2),incoord(2),outcoord(2),matrix(3,3)
  real(kind=4) :: oldin,oldout,inoff(2),outoff(2)
  save oldin,oldout,matrix,oldcoord,outcoord
  ! Data
  data oldin/0.0/, oldout/-1.0/
  !
  if (inequinox.eq.equinox_null .neqv. equinox.eq.equinox_null) then
    ! Only one equinox is unknown. If both are unknown, this is accepted
    call gwcs_message(seve%e,'SYSTEM',  &
      'Cannot convert EQUATORIAL to/from EQUATORIAL with unknown Equinox')
    error = .true.
    return
  endif
  !
  incoord(1) = inra
  incoord(2) = indec
  inoff(1) = inroff
  inoff(2) = indoff
  if (oldin.ne.inequinox .or. oldout.ne.equinox) then
    call chgcoo ('EQ','EQ',inequinox,equinox,matrix)
    oldin = inequinox
    oldout = equinox
    call chgref (matrix,incoord,outcoord)
  elseif (incoord(1).ne.oldcoord(1) .or. incoord(2).ne.oldcoord(2)) then
    call chgref (matrix,incoord,outcoord)
  endif
  oldcoord(1) = incoord(1)
  oldcoord(2) = incoord(2)
  if (inoff(1).ne.0.0 .or. inoff(2).ne.0.0) then
    call chgoff (matrix,incoord,inoff,outcoord,outoff)
  else
    outoff(1)=0.0
    outoff(2)=0.0
  endif
  ra = outcoord(1)
  dec = outcoord(2)
  raoff = outoff(1)
  decoff = outoff(2)
  !
end subroutine equ_to_equ
!
subroutine equ_equ_0d(ra1,dec1,equinox1,ra2,dec2,equinox2,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>equ_equ_0d
  !---------------------------------------------------------------------
  ! @ public-generic equ_equ
  !  Convert 1 position from Equatorial+Equinox to Equatorial+Equinox
  !  Scalar version
  !---------------------------------------------------------------------
  real(kind=8),    intent(in)    :: ra1       !
  real(kind=8),    intent(in)    :: dec1      !
  real(kind=4),    intent(in)    :: equinox1  !
  real(kind=8),    intent(out)   :: ra2       !
  real(kind=8),    intent(out)   :: dec2      !
  real(kind=4),    intent(in)    :: equinox2  !
  logical,         intent(inout) :: error     !
  ! Local
  real(kind=8) :: r1(1),d1(1),r2(1),d2(1)
  !
  r1(1) = ra1
  d1(1) = dec1
  call equ_equ_1d(r1,d1,equinox1,r2,d2,equinox2,1,error)
  if (error)  return
  ra2 = r2(1)
  dec2 = d2(1)
  !
end subroutine equ_equ_0d
!
subroutine equ_equ_1d(ra1,dec1,equinox1,ra2,dec2,equinox2,n,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>equ_equ_1d
  !---------------------------------------------------------------------
  ! @ public-generic equ_equ
  !  Convert 1 position from Equatorial+Equinox to Equatorial+Equinox
  !  1D-array version
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: n         !
  real(kind=8),    intent(in)    :: ra1(n)    !
  real(kind=8),    intent(in)    :: dec1(n)   !
  real(kind=4),    intent(in)    :: equinox1  !
  real(kind=8),    intent(out)   :: ra2(n)    !
  real(kind=8),    intent(out)   :: dec2(n)   !
  real(kind=4),    intent(in)    :: equinox2  !
  logical,         intent(inout) :: error     !
  ! Local
  integer(kind=4) :: i
  real(kind=8) :: in(2),out(2),matrix(3,3)
  !
  if (equinox1.eq.equinox_null .neqv. equinox2.eq.equinox_null) then
    ! Only one equinox is unknown. If both are unknown, this is accepted
    ! since the operation is transparent (see below)
    call gwcs_message(seve%e,'SYSTEM',  &
      'Cannot convert EQUATORIAL to/from EQUATORIAL with unknown Equinox')
    error = .true.
    return
  endif
  !
  if (equinox1.ne.equinox2) then
    call chgcoo ('EQ','EQ',equinox1,equinox2,matrix)
    do i=1,n
      in(1) = ra1(i)
      in(2) = dec1(i)
      call chgref (matrix,in,out)
      ra2(i) = out(1)
      dec2(i) = out(2)
    enddo
  else
    do i=1,n
      ra2(i) = ra1(i)
      dec2(i) = dec1(i)
    enddo
  endif
end subroutine equ_equ_1d
!
subroutine equ_equ_2d(ra1,dec1,equinox1,ra2,dec2,equinox2,n,m,error)
  use gbl_constant
  use gbl_message
  use gwcs_interfaces, except_this=>equ_equ_2d
  !---------------------------------------------------------------------
  ! @ public-generic equ_equ
  !  Convert 1 position from Equatorial+Equinox to Equatorial+Equinox
  !  2D-array version
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: n,m        !
  real(kind=8),    intent(in)    :: ra1(n,m)   !
  real(kind=8),    intent(in)    :: dec1(n,m)  !
  real(kind=4),    intent(in)    :: equinox1   !
  real(kind=8),    intent(out)   :: ra2(n,m)   !
  real(kind=8),    intent(out)   :: dec2(n,m)  !
  real(kind=4),    intent(in)    :: equinox2   !
  logical,         intent(inout) :: error      !
  !
  call equ_equ_1d(ra1,dec1,equinox1,ra2,dec2,equinox2,n*m,error)
  !
end subroutine equ_equ_2d
!
subroutine chgcoo(oldtyp,newtyp,oldepo,newepo,matrix)
  use gwcs_interfaces, except_this=>chgcoo
  !---------------------------------------------------------------------
  ! @ public
  !  Change Coordinate system
  !------------------------------------------------------------------------
  character(len=2), intent(in)  :: oldtyp        ! Coordinate input type
  character(len=2), intent(in)  :: newtyp        ! Coordinate output type
  real(kind=4),     intent(in)  :: oldepo        ! Coordinate input epoch (if 'EQ')
  real(kind=4),     intent(in)  :: newepo        ! Coordinate output epoch (if 'EQ')
  real(kind=8),     intent(out) :: matrix(3,3)   ! Rotation Matrix
  ! Local
  real(kind=8) :: mat1(3,3), mat2(3,3)
  real(kind=8), parameter :: j2000=2451545.0d0        ! reference epoch (julian days)
  real(kind=8), parameter :: j1950=j2000-50*365.25d0  ! reference epoch (julian days)
  real(kind=8) :: jold, jnew, angles(6)
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  real(kind=8), parameter :: halfpi=pi/2.0d0, twopi=2.d0*pi
  real(kind=8), parameter :: degrad=pi/180.0d0
  real(kind=8), parameter :: psi=degrad*33., theta=-degrad*62.6, phi=-degrad*282.25
  !
  ! Compute rotation matrix
  ! Precession only
  if (oldtyp.eq.'EQ' .and. newtyp.eq.'EQ') then
    if (oldepo .eq. newepo) return
    jold = j2000 + (oldepo-2000.d0)*365.25d0
    jnew = j2000 + (newepo-2000.d0)*365.25d0
    call qprec(jold,jnew,angles)
    call eulmat(-angles(1)+halfpi, angles(3), -angles(2)-halfpi, matrix)
    !
    ! Change of frame
  elseif (oldtyp.eq.'EQ' .and. newtyp.eq.'GA') then
    jold = j2000 + (oldepo-2000.d0)*365.25d0
    call qprec(jold,j1950,angles)
    call eulmat(-angles(1)+halfpi, angles(3), -angles(2)-halfpi, mat1)
    call eulmat(-phi, -theta, -psi, mat2)
    call mulmat(mat1, mat2, matrix)
  elseif (oldtyp.eq.'GA' .and. newtyp.eq.'EQ') then
    call eulmat(psi, theta, phi, mat1)
    jnew = j2000 + (newepo-2000.d0)*365.25d0
    call qprec(j1950,jnew,angles)
    call eulmat(-angles(1)+halfpi, angles(3), -angles(2)-halfpi, mat2)
    call mulmat(mat1, mat2, matrix)
  endif
  !
end subroutine chgcoo
!
subroutine chgref(matrix, oldref, newref)
  use gwcs_interfaces, except_this=>chgref
  !---------------------------------------------------------------------
  ! @ private
  ! Computes the coordinates of the reference direction in the new system
  !---------------------------------------------------------------------
  real(kind=8), intent(in)  :: matrix(3,3)  ! Rotation matrix
  real(kind=8), intent(in)  :: oldref(2)    ! Old coordinates (radians)
  real(kind=8), intent(out) :: newref(2)    ! New coordinates (radians)
  ! Local
  real(kind=8) :: xold(3), xnew(3)
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  real(kind=8), parameter :: twopi=2.d0*pi
  !
  ! Go to cartesian
  xold(1) = cos(oldref(1)) * cos(oldref(2))
  xold(2) = sin(oldref(1)) * cos(oldref(2))
  xold(3) = sin(oldref(2))
  !
  ! Rotate
  call matvec(xold, matrix, xnew)
  !
  ! Back to spherical
  newref(1) = atan2(xnew(2), xnew(1))
  do while (newref(1) .lt. 0)
    newref(1) = newref(1) + twopi
  enddo
  do while (newref(1) .gt. twopi)
    newref(1) = newref(1) - twopi
  enddo
  newref(2) = atan2(xnew(3), sqrt(xnew(1)**2 + xnew(2)**2) )
  !
end subroutine chgref
!
subroutine chgoff(matrix,oldref,oldoff,newref,newoff)
  use gwcs_interfaces, except_this=>chgoff
  !---------------------------------------------------------------------
  ! @ private
  ! Compute offsets in the new system
  !------------------------------------------------------------------------
  real(kind=8), intent(in)  :: matrix(3,3)  ! Rotation matrix
  real(kind=8), intent(in)  :: oldref(2)    ! Old coordinates (radians)
  real(kind=4), intent(in)  :: oldoff(2)    ! Old offsets (radians)
  real(kind=8), intent(in)  :: newref(2)    ! New coordinates (radians)
  real(kind=4), intent(out) :: newoff(2)    ! New offsets (radians)
  ! Local
  real(kind=8) :: oldpos(2), newpos(2)
  !
  ! position in old coordinates
  oldpos(2) = oldref(2) + oldoff(2)
  oldpos(1) = oldref(1) + oldoff(1) / cos(oldpos(2))
  !
  ! rotate
  call chgref(matrix, oldpos, newpos)
  !
  ! new offsets
  newoff(2) = newpos(2) - newref(2)
  newoff(1) = (newpos(1) - newref(1)) * cos(newpos(2))
  !
end subroutine chgoff
!
subroutine qprec (ti,tf,angles)
  !---------------------------------------------------------------------
  ! @ public
  !  precession entre deux epoques selon Lieske et al (1977)
  !  from EPHAUT / BDL / C002 / 81-1
  !  modified 29 november 1984 by Michel Perault
  !  calcul de quantites liees aux deplacements precessionnels de
  !  l'equateur et de l'ecliptique entre deux epoques donnees
  !  en entree : TI epoque initiale (jours juliens)
  !              TF epoque finale (jours juliens)
  !  en sortie : ANGLES(1-3) quantites liees au deplacement precessionnel
  !              de l'equateur entre TI et TF (radian)
  !              ANGLES(4-6) quantites liees au deplacement precessionnel
  !              de l'ecliptique entre TI et TF (radian)
  !  notations : ANGLES(1) = DZETA
  !              ANGLES(2) = Z
  !              ANGLES(3) = TETA
  !              ANGLES(4) = petit PI
  !              ANGLES(5) = grand PI
  !              ANGLES(6) = P (precession generale en longitude)
  !  remarque  : les temps sont mesures en siecle julien a partir de
  !              l'epoque J2000.0 (JJ2451545)
  !---------------------------------------------------------------------
  real(kind=8), intent(in)  :: ti         !
  real(kind=8), intent(in)  :: tf         !
  real(kind=8), intent(out) :: angles(6)  !
  ! Local
  real(kind=8), parameter :: sdrad=0.4848136811095360d-5
  real(kind=8), parameter :: t0=2451545.d0, siecle=36525.d0
  real(kind=8) :: t,t2,pt,pt2,pt3
  real(kind=8) :: dzeta1,dzeta2,dzeta3,za1,za2,za3,teta1,teta2,teta3
  real(kind=8) :: ppia1,ppia2,ppia3,gpia0,gpia1,gpia2,pa1,pa2,pa3
  !
  angles(:)=0.d0
  if (ti.eq.tf) return
  !
  t=(ti-t0)/siecle
  t2=t*t
  pt=(tf-ti)/siecle
  pt2=pt*pt
  pt3=pt*pt2
  !  precession equatoriale
  dzeta1=(2306.2181d0+1.39656d0*t-0.139d-3*t2)*sdrad
  dzeta2=(0.30188d0-0.345d-3*t)*sdrad
  dzeta3=0.17998d-1*sdrad
  za1=dzeta1
  za2=(1.09468d0+0.66d-4*t)*sdrad
  za3=0.18203d-1*sdrad
  teta1=(2004.3109d0-0.8533d0*t-0.217d-3*t2)*sdrad
  teta2=(-0.42665d0-0.217d-3*t)*sdrad
  teta3=-0.41833d-1*sdrad
  angles(1)=dzeta1*pt+dzeta2*pt2+dzeta3*pt3
  angles(2)=za1*pt+za2*pt2+za3*pt3
  angles(3)=teta1*pt+teta2*pt2+teta3*pt3
  !  precession ecliptique
  ppia1=(47.0029d0-0.6603d-1*t+0.598d-3*t2)*sdrad
  ppia2=(-0.3302d-1+0.598d-3*t)*sdrad
  ppia3=0.6d-4*sdrad
  gpia0=(629554.982d0+3289.4789d0*t+0.60622d0*t2)*sdrad
  gpia1=(-869.8089d0-0.50491d0*t)*sdrad
  gpia2=0.3536d-1*sdrad
  pa1=(5029.0966d0+2.22226d0*t-0.42d-4*t2)*sdrad
  pa2=(1.11113d0-0.42d-4*t)*sdrad
  pa3=-0.6d-5*sdrad
  angles(4)=ppia1*pt+ppia2*pt2+ppia3*pt3
  angles(5)=gpia0+gpia1*pt+gpia2*pt2
  angles(6)=pa1*pt+pa2*pt2+pa3*pt3
  return
end subroutine qprec
!
subroutine b1950_to_j2000(obs_epoch,alpha,delta)
  use gwcs_interfaces, except_this=>b1950_to_j2000
  !---------------------------------------------------------------------
  ! @ public
  ! Convert Besselian coordinates to J2000, assuming zero proper motion,
  ! parallax, and radial velocity. Calls the general implementation of
  ! the formulas from Aoki et al AA 128, 263 (1983)
  !---------------------------------------------------------------------
  real(kind=4), intent(in)    :: obs_epoch  !
  real(kind=8), intent(inout) :: alpha      !
  real(kind=8), intent(inout) :: delta      !
  ! Local
  real(kind=8) :: observed_epoch
  real(kind=8) :: mu_alph,mu_delt,parallax,radvel
  !
  observed_epoch = obs_epoch
  mu_alph  = 0.d0
  mu_delt  = 0.d0
  parallax = 0.d0
  radvel   = 0.d0
  call full_b1950_to_j2000(observed_epoch,alpha,delta,mu_alph,mu_delt,  &
  parallax,radvel)
end subroutine b1950_to_j2000
!
subroutine full_b1950_to_j2000(obs_epoch,lambda,beta,mu_alph,mu_delt,  &
  parallax,radvel)
  use gwcs_interfaces, except_this=>full_b1950_to_j2000
  !---------------------------------------------------------------------
  ! @ private
  ! Convert Besselian coordinates to J2000.
  ! Implementation of the general formulas given in Aoki et al AA 128,
  ! 263 (1983), modified (not totally sure the modification is totally
  ! consistent, but the potentially remaining inconsistencies should be
  ! small for practical cases) to handle the case of a non-B1950 observing
  ! epoch.
  !
  ! NOT YET FINISHED, STILL RESTRICTED TO NO PM, NO PARALLAX, NO RV,
  ! BUT WORKS AS BEFORE IN THIS RESTRICTED CASE
  !---------------------------------------------------------------------
  real(kind=8), intent(in)    :: obs_epoch  !
  real(kind=8), intent(inout) :: lambda     !
  real(kind=8), intent(inout) :: beta       !
  real(kind=8), intent(in)    :: mu_alph    !
  real(kind=8), intent(in)    :: mu_delt    !
  real(kind=8), intent(in)    :: parallax   !
  real(kind=8), intent(in)    :: radvel     !
  ! Global
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  ! Local
  integer(kind=4) :: i
  real(kind=8) :: mat_rr(9), mat_rv(9), mat_full(36)
  real(kind=8) :: s_0(2), x_0(3), v_0(3)
  real(kind=8) :: x_1(3), v_1(3), xv_1(6)
  real(kind=8) :: x(3), v(3), a_1(3), dt1
  real(kind=8) :: a_vec(3), aa, a_point(3), ap, b1950, tcent, jcent, dt
  real(kind=8) :: calp,salp,cdec,sdec
  equivalence (x_1(1),xv_1(1)),(v_1(1),xv_1(4))
  !
  data mat_rr/ 0.9999256782d0,  0.0111820609d0,  0.0048579479d0,  &
              -0.0111820610d0,  0.9999374784d0, -0.0000271474d0,  &
              -0.0048579477d0, -0.0000271765d0,  0.9999881997d0/
  data mat_rv/-0.00055d0,  0.23849d0, -0.43562d0,  &
              -0.23854d0, -0.00267d0,  0.01225d0,  &
               0.43574d0, -0.00854d0,  0.00212d0/
  data mat_full/ 0.9999256782d0,   0.0111820609d0,   0.0048579479d0,   &
                -0.00055d0,        0.23849d0,       -0.43562d0,        &
                -0.0111820610d0,   0.9999374784d0,  -0.0000271474d0,   &
                -0.23854d0,       -0.00267d0,        0.01225d0,        &
                -0.0048579477d0,  -0.0000271765d0,   0.9999881997d0,   &
                 0.43574d0,       -0.00854d0,        0.00212d0,        &
                +0.0000024239502, +0.0000000271066, +0.0000000117766,  &
                +0.99994704d0,    +0.01118251d0,    +0.00485767d0,     &
                -0.0000000271066, +0.0000024239788, -0.0000000000658,  &
                -0.01118251d0,    +0.99995883d0,    -0.00002714d0,     &
                -0.0000000117766, -0.0000000000659, +0.0000024241017,  &
                +0.00485767d0,    -0.00002718d0,    +1.00000956d0/
  data a_vec /-1.62557d-6, -0.31919d-6, -0.13843d-6/
  data a_point /1.245d-3, -1.580d-3, -0.659d-3/
  data b1950/2433282.42345905d0/, tcent/36524.2198781d0/, jcent/36525d0/
  !
  ! Compute rectangular position and velocity, in the old system
  s_0(1) = lambda
  s_0(2) = beta
  call rect (s_0, x_0)
  calp = cos(lambda)
  salp = sin(lambda)
  cdec = cos(beta)
  sdec = sin(beta)
  v_0(1) = 15*mu_alph*(-cdec*salp)+mu_delt*(-sdec*calp)
  v_0(2) = 15*mu_alph*(+cdec*calp)+mu_delt*(-sdec*salp)
  v_0(3) =                 0      +mu_delt*cdec
  do i=1,3
    v_0(i) = v_0(i)+21.094502*parallax*radvel*x_0(i)
  enddo
  ! Remove the E-terms of aberration and their variation's effect.
  dt1 = (obs_epoch-1950.0)*365.25/tcent
  do i=1,3
    a_1(i) = a_vec(i)+dt1*a_point(i)*pi/180d0/3600d0
  enddo
  aa = x_0(1)*a_1(1)+x_0(2)*a_1(2)+x_0(3)*a_1(3)
  do i=1, 3
    x_1(i) = x_0(i)*(1d0+aa) - a_1(i)
  enddo
  ap = x_0(1)*a_1(1)+x_0(2)*a_1(2)+x_0(3)*a_1(3)
  do i=1,3
    v_1(i) = v_0(i)-a_point(i)+ap*x_0(i)   ! Should that rather be X_1??
  enddo
  !
  call matvec (x_1, mat_rr, x)
  call matvec (x_1, mat_rv, v)
  dt = (obs_epoch-2000)*365.25/jcent
  do i=1, 3
    x(i) = x(i)+ dt*v(i)*pi/180d0/3600d0
  enddo
  call spher (x, s_0)
  lambda = s_0(1)
  beta = s_0(2)
  !
end subroutine full_b1950_to_j2000
!
subroutine do_precess(epoch, new_epoch, lambda, beta)
  use gwcs_interfaces, except_this=>do_precess
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  real(kind=4), intent(inout) :: epoch      !
  real(kind=4), intent(in)    :: new_epoch  !
  real(kind=8), intent(inout) :: lambda     !
  real(kind=8), intent(inout) :: beta       !
  ! Global
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  ! Local
  real(kind=8), parameter :: j2000=2451545.0d0
  real(kind=8) :: s(2), x_0(3), x_1(3), matrix(9), psi, the, phi
  real(kind=8) :: angles(6), j0, j1
  !
  s(1) = lambda
  s(2) = beta
  call rect (s, x_0)
  j0 = j2000+(epoch-2000.0d0)*365.25d0 ! fixed epoch (julian days)
  j1 = j2000+(new_epoch-2000.0d0)*365.25d0 ! fixed epoch (julian days)
  call qprec(j0,j1,angles)
  psi = pi/2d0-angles(1)       ! Euler angles of transformation
  the = angles(3)
  phi = -pi/2d0-angles(2)
  call eulmat (psi,the,phi,matrix)
  call matvec (x_0, matrix, x_1)
  call spher (x_1, s)
  lambda = s(1)
  beta = s(2)
  epoch = new_epoch
  !
end subroutine do_precess
!
subroutine spher (x, a)
  !---------------------------------------------------------------------
  ! @ public
  !       CARTESIAN TO SPHERICAL COORDINATE CONVERSION
  !------------------------------------------------------------------------
  real(kind=8), intent(in)  :: x(3)  ! Cartesian coordinates
  real(kind=8), intent(out) :: a(2)  ! Spherical coordinates
  !
  if (x(1).eq.0d0 .and. x(2).eq.0d0) then
    a(1) = 0d0
    a(2) = atan2 (x(3), 0.d0)
  else
    a(1) = atan2(x(2), x(1))
    a(2) = atan2(x(3), sqrt(x(1)**2 + x(2)**2) )
  endif
end subroutine spher
!
subroutine rect (a, x)
  !---------------------------------------------------------------------
  ! @ public
  !       SPHERICAL TO CARTESIAN COORDINATES CONVERSION
  !---------------------------------------------------------------------
  real(kind=8), intent(in)  :: a(2)  ! Spherical coordinates
  real(kind=8), intent(out) :: x(3)  ! Cartesian coordinates
  !
  x(1) = cos(a(1)) * cos(a(2))
  x(2) = sin(a(1)) * cos(a(2))
  x(3) = sin(a(2))
end subroutine rect
!
subroutine eq1950_to_gal(a,d,lii,bii,n)
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !       Converts (A,D) (1950.0) in LII,BII
  !       Units are radians
  !---------------------------------------------------------------------
  real(kind=8),    intent(in)  :: a(*)    !
  real(kind=8),    intent(in)  :: d(*)    !
  real(kind=8),    intent(out) :: lii(*)  !
  real(kind=8),    intent(out) :: bii(*)  !
  integer(kind=4), intent(in)  :: n       !
  ! Local
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  real(kind=8), parameter :: precision=1.0d-10
  real(kind=8), parameter :: c626=0.4601997847838517d0
  real(kind=8), parameter :: s626=0.8878153851364013d0
  real(kind=8) :: aa,cosa,sina,cosdec,sindec,expr
  integer(kind=4) :: i
  !
  ! Formulaes are in degrees (LANG K.R. page 504)
  !
  !       SIN(Bii)             = SIN(D)COS(62.6) - COS(D)SIN(A-282.25)SIN(62.6)
  !       COS(Bii)*COS(Lii-33) = COS(D)COS(A-282.25)
  !       COS(Bii)*SIN(Lii-33) = COS(D)SIN(A-282.25)COS(62.6) + SIN(D)SIN(62.6)
  !
  ! which is
  !  SIN(Bii)    = SIN(Dec)COS(90-DecGalPol)
  !               -COS(Dec)SIN(RA-(RAGalPol+90))SIN(DecGalPol)
  !  COS(Bii)*COS(Lii-(GlonRAPol-90)) = COS(Dec)COS(RA-(RAGalPol+90))
  !  COS(Bii)*SIN(Lii-(GlonRAPol-90)) =
  !                       COS(Dec)SIN(RA-(RAGalPol+90))COS(90-DecGalPol)
  !                     + SIN(Dec)SIN(90-DecGalPol)
  !
  do i=1,n
    aa = a(i)-282.25d0*pi/180.d0
    cosa = cos(aa)
    sina = sin(aa)
    cosdec = cos(d(i))
    sindec = sin(d(i))
    !
    expr = cosdec*sina
    bii(i) = asin (sindec*c626 - expr*s626)
    lii(i) = atan2( (expr*c626+sindec*s626),cosdec*cosa ) + 33.d0*pi/180.d0
    ! Force Lii to the usual [0,2*PI[ determination 11-APR-91 TF
    if (lii(i).lt.0) lii(i) = lii(i)+2*pi
  enddo
  !
end subroutine eq1950_to_gal
!
subroutine gal_to_eq1950(lii,bii,a,d,n)
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !       Converts Lii,Bii to (A,D) (1950.0)
  !       Units are radians
  !---------------------------------------------------------------------
  real(kind=8),    intent(in)  :: lii(*)  !
  real(kind=8),    intent(in)  :: bii(*)  !
  real(kind=8),    intent(out) :: a(*)    !
  real(kind=8),    intent(out) :: d(*)    !
  integer(kind=4), intent(in)  :: n       !
  ! Local
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  real(kind=8), parameter :: precision=1.0d-10
  real(kind=8), parameter :: c626=0.4601997847838517d0
  real(kind=8), parameter :: s626=0.8878153851364013d0
  real(kind=8) :: ll,sinb,cosb,sinl,cosl,expr
  integer(kind=4) :: i
  !
  ! The conversion formulae are
  !       COS(D)SIN(A-282.25) = COS(Bii)SIN(Lii-33)COS(62.6) - SIN(Bii)SIN(62.6)
  !       COS(D)COS(A-282.25) = COS(Bii)COS(Lii-33)
  !       SIN(D)              = COS(Bii)SIN(Lii-33)SIN(62.6) + SIN(Bii)COS(62.6)
  !
  do i = 1,n
    ll   = lii(i) - 33.d0*pi/180.d0
    sinb = sin(bii(i))
    cosb = cos(bii(i))
    sinl = sin(ll)
    cosl = cos(ll)
    !
    expr = cosb*sinl
    d(i) = asin ( expr*s626 + sinb*c626 )
    a(i) = atan2 ( expr*c626-sinb*s626,cosb*cosl ) + 282.25d0*pi/180.d0
    ! Force RA to the usual [0,2*PI[ determination 11-APR-91 TF
    if (a(i).ge.2*pi) a(i) = a(i)-2*pi
  enddo
  !
end subroutine gal_to_eq1950
