subroutine jjdate (tjj,date)
  !---------------------------------------------------------------------
  ! @ public
  !  Conversion d'une date julienne en date du calendrier gregorien
  !  from EPHAUT / BDL / ? / 82-1
  !  modified 29 november 1984 by Michel Perault
  !  en entree : TJJ date julienne (jours juliens)
  !  en sortie : DATE date gregorienne (year, month, day, hour, minute, second)
  !  remarque  : le calcul couvre la periode julienne de l'an
  !              4713 avant notre ere a l'an 3267 de notre ere.
  !              les annees sont comptees en millesimes astronomiques
  !              l'annee qui precede l'an 1 de notre ere est l'an 0
  !              ex : l'an 80 avant notre ere a le millesime -79.
  !  rappel    : la periode du 5 octobre 1582 0h au 14 octobre 1582
  !              24 h n'existe pas
  !---------------------------------------------------------------------
  real(kind=8) :: tjj               !
  integer(kind=4) :: date(7)        !
  ! Local
  integer(kind=4) :: year,month,day,hour,minute,second,millisec
  integer(kind=4) :: i
  real(kind=8) :: t,z,f,a,x,b,c,d,e
  do i=1,7
    date(i)=0
  enddo
  if (tjj.le.0.d0) return
  ! T=TJJ+0.5D0/86400.D0+0.5D0
  t=tjj+0.5d0
  z=int(t)
  f=t-z
  a=z
  if (z.ge.2299161.d0) then
    x=int((z-1867216.25d0)/36524.25d0)
    a=z+1.d0+x-int(x/4.d0)
  endif
  b=a+1524.d0
  c=int((b-122.1d0)/365.25d0)
  d=int(365.25d0*c)
  e=int((b-d)/30.6001d0)
  day=b-d-int(30.6001d0*e)
  month=e-1.d0
  if (e.gt.13.5d0) month=e-13.d0
  year=c-4716.d0
  if (month.lt.2.5d0) year=c-4715.d0
  second=+1
  f=f*24.d0
  hour=f
  f=(f-hour)*60.d0
  minute=f
  f=(f-minute)*60.d0
  second=f
  f = (f-second)*1000.d0
  millisec=f
  date(1)=year
  date(2)=month
  date(3)=day
  date(4)=hour
  date(5)=minute
  date(6)=second
  date(7) = millisec
  return
end subroutine jjdate
!
subroutine datejj (date,tjj)
  !---------------------------------------------------------------------
  ! @ public
  !  conversion d'une date du calendrier gregorien en date julienne
  !  from EPHAUT / BDL / ? / 82-1
  !  modified 29 november 1984 by Michel Perault
  !  en entree : DATE date gregorienne (year, month, day, hour, minute, second
  !		, millisecond)
  !  en sortie : TJJ date julienne (jours juliens)
  !  remarque  : le calcul couvre la periode julienne de l'an
  !              4713 avant notre ere a l'an 3267 de notre ere.
  !              les annees sont comptees en millesimes astronomiques
  !              l'annee qui precede l'an 1 de notre ere est l'an 0
  !              ex : l'an 80 avant notre ere a le millesime -79.
  !  rappel    : la periode du 5 octobre 1582 0h au 14 octobre 1582
  !              24 h n'existe pas
  !---------------------------------------------------------------------
  integer(kind=4) :: date(7)        !
  real(kind=8) :: tjj               !
  ! Local
  integer(kind=4) :: year,month,day,hour,minute,second, millisecond
  integer(kind=4) :: m
  real(kind=8) :: b,c,y,a
  !
  tjj=0.d0
  year=date(1)
  month=date(2)
  day=date(3)
  hour=date(4)
  minute=date(5)
  second=date(6)
  millisecond = date(7)
  if (year.lt.-4712.or.year.gt.3267) return
  if (month.lt.1.or.month.gt.12) return
  if (day.lt.0.or.day.gt.31) return
  if (hour.lt.0.or.hour.gt.24) return
  if (minute.lt.0.or.minute.gt.60) return
  if (second.lt.0.or.second.gt.60) return
  if (millisecond.lt.0.or.millisecond.gt.1000) return
  y=year
  m=month
  b=0.d0
  c=0.d0
  if (month.le.2) then
    y=y-1.d0
    m=m+12
  endif
  if (y.lt.0) then
    c=-0.75d0
  else
    if (year.gt.1582 .or. (year.eq.1582 .and. (month.gt.10 .or. (month.eq.10  &
       .and. day.gt.14)))) then
      a=int(y/100.d0)
      b=2.d0-a+int(a/4.d0)
    elseif (year.eq.1582 .and. month.eq.10 .and. day.ge.5 .and. day.le.14) then
      return
    endif
  endif
  tjj=int(365.25d0*y+c)+int(30.6001d0*(m+1))+day+dble(hour)/24.d0+            &
      dble(minute)/1440.d0+dble(second)/86400.d0+dble(millisecond)/86400.d3+  &
      1720994.5d0+b
  return
end subroutine datejj
!
function tsmg (tjj)
  !---------------------------------------------------------------------
  ! @ private
  !  calcul du temps sideral moyen de Greenwich (radian)
  !  from EPHAUT / BDL / A002 / 82-1
  !  modified 29 november 1984 by Michel Perault
  !  reference Aoki et al. (1982, Astron. Astrophys. 105, 359)
  !  en entree : TJJ date (jours juliens)
  !  remarques : on utilise le formulaire UAI84
  !              l'epoque de reference est J2000.0 (JJ2451545.0)
  !              le temps est compte en siecle julien
  !---------------------------------------------------------------------
  real(kind=8) :: tsmg              !
  real(kind=8) :: tjj               !
  ! Local
  real(kind=8) :: tf,shrad
  parameter (tf=2451545.0d0,shrad=0.7272205216643040d-4)
  real(kind=8) :: t,t2,t3,alfsm,h,x
  !
  t=(tjj-tf)/36525.d0
  t2=t*t
  t3=t2*t
  !
  !  calcul du temps sideral moyen
  alfsm=67310.54841d0+8640184.812866d0*t+0.93104d-1*t2-0.62d-5*t3
  h=(tjj-int(tjj))*86400.d0
  x=dmod(alfsm+h,86400.d0)
  if (x.lt.0.d0) x=x+86400.d0
  x=x*shrad
  tsmg=x
end function tsmg
!
function oblimo (tjj)
  !---------------------------------------------------------------------
  ! @ private
  !  calcul de l'obliquite moyenne (radian), precession selon Lieske et al. (1977)
  !  from EPHAUT / BDL / C004 / 82-1
  !  modified 29 november 1984 by Michel Perault
  !  en entree : TJJ date (jours juliens)
  !---------------------------------------------------------------------
  real(kind=8) :: oblimo            !
  real(kind=8) :: tjj               !
  ! Local
  real(kind=8) :: sdrad,tj0,siecle
  parameter (sdrad=0.4848136811095360d-5)
  parameter (tj0=2451545.d0,siecle=36525.d0)
  real(kind=8) :: epsm,t,t2,t3
  !
  ! calcul de l'obliquite
  t=(tjj-tj0)/siecle
  t2=t*t
  t3=t2*t
  epsm=84381.448d0-46.815d0*t-0.59d-3*t2+0.1813d-2*t3
  oblimo=epsm*sdrad
  return
end function oblimo
!
subroutine nuta (tjj,dpsi,deps)
  !---------------------------------------------------------------------
  ! @ private
  !  calcul de la nutation en longitude et en obliquite a la date TJJ
  !  d'apres les formules de WAHR (1981)
  !  from EPHAUT / BDL / D003 / 81-1
  !  modified 29 november 1984 by Michel Perault
  !  only the terms with amplitude larger than 0.004 arcsec are kept
  !  en entree :  TJJ date (jours juliens)
  !  en sortie :  DPSI nutation en longitude (radian)
  !		DEPS nutation en obliquite (radian)
  !  remarques :  l'epoque de reference pour le calcul de la nutation
  !		est TF1 : 1 janvier 2000 12h (J2000.0)
  !		l'epoque de reference pour le calcul des arguments
  !		fondamentaux est TF2 : 0 janvier 1900 12h
  !---------------------------------------------------------------------
  real(kind=8) :: tjj               !
  real(kind=8) :: dpsi              !
  real(kind=8) :: deps              !
  ! Local
  real(kind=8) :: tf1,tf2,sdrad,dgrad
  parameter (tf1=2451545.0d0,tf2=2415020.0d0)
  parameter (sdrad=0.4848136811095360d-5)
  parameter (dgrad=0.1745329251994330d-1)
  real(kind=8) :: l,p,f,d,g
  real(kind=8) :: t,tj,s,s2,s3
  real(kind=8) :: a,e
  !
  t=(tjj-tf1)/365250.d0
  tj=tjj-tf2
  s=tj/36525.d0
  s2=s*s
  s3=s2*s
  !
  !  arguments fondamentaux
  l=296.104608d0+13.0649924465d0*tj+0.9192d-2*s2+0.143d-4*s3
  l=dmod(l,360.d0)*dgrad
  p=358.475833d0+0.9856002669d0*tj-0.149d-3*s2-0.331d-5*s3
  p=dmod(p,360.d0)*dgrad
  f=11.250889d0+13.2293504490d0*tj-0.3211d-2*s2-0.341d-6*s3
  f=dmod(f,360.d0)*dgrad
  d=350.737681d0+12.1907491914d0*tj-0.1436d-2*s2+0.19d-5*s3
  d=dmod(d,360.d0)*dgrad
  g=259.183275d0-0.0529539222d0*tj+0.2078d-2*s2+0.2d-5*s3
  g=dmod(g,360.d0)*dgrad
  !
  !  nutation en longitude (20 terms)
  a=(-171996-1742*t)*dsin(g) + (2062+2*t)*dsin(2*g) + 46*dsin(-2*l+2*f+g)
  a=a + (-13187-16*t)*dsin(2*f-2*d+2*g) + (1426-34*t)*dsin(p) +             &
        (-517+12*t)*dsin(p+2*f-2*d+2*g) + (217-5*t)*dsin(-p+2*f-2*d+2*g) +  &
        (129+t)*dsin(2*f-2*d+g) + 48*dsin(2*l-2*d)
  a=a + (-2274-2*t)*dsin(2*f+2*g) + (712+t)*dsin(l) + (-386-4*t)*dsin(2*f+g)  &
      - 301*dsin(l+2*f+2*g) - 158*dsin(l-2*d) + 123*dsin(-l+2*f+2*g) +        &
        63*dsin(2*d) + (63+t)*dsin(l+g) + (-58-t)*dsin(-l+g) -                &
        59*dsin(-l+2*f+2*d+2*g) - 51*dsin(l+2*f+g)
  dpsi=a*sdrad/1.d4
  !
  !  nutation en obliquite (11 terms)
  e=(92025+89*t)*dcos(g) + (-895+5*t)*dcos(2*g)
  e=e + (5736-31*t)*dcos(2*f-2*d+2*g) + (54-t)*dcos(p) +                  &
        (224-6*t)*dcos(p+2*f-2*d+2*g) + (-95+3*t)*dcos(-p+2*f-2*d+2*g) -  &
        70*dcos(2*f-2*d+g)
  e=e + (977-5*t)*dcos(2*f+2*g) + 200*dcos(2*f+g) + (129-t)*dcos(l+2*f+2*g) -  &
        53*dcos(-l+2*f+2*g)
  deps=e*sdrad/1.d4
  return
end subroutine nuta
!
subroutine ctcheb (values,degree,coeff,error)
  !---------------------------------------------------------------------
  ! @ private
  !     Approximation d'une fonction par un developpement en polynomes de
  !     Tchebychev sur un intervalle de variation donne
  !  Loosely inspired from EPHAUT / BDL / J002 / 81-1
  !  Modified 5 October 1985 - Michel Perault - POM Version 2.0
  !  Input :
  !	VALUES(0:DEGREE) function at Tchebychev abscissa
  !	DEGREE	degree of representation
  !  Output :
  !	COEFF(0:DEGREE)	coefficients of Tchebychev polynomes
  !	ERROR	logical, if improper value of DEGREE
  !  Notes :
  !	VALUES et COEFF sont exprimes dans la meme unite.
  !	Les abscisses de tchebychev sur l'intervalle (-1,+1) sont donnees
  !	par la relation suivante :
  !                 Xk = cos((2*k+1)*pi/(2*(DEGREE+1))  pour k = 0,DEGREE+1
  !	Les valeurs de la fonction aux abscisses de Tchebychev ne doivent
  !	pas presenter de discontinuite.
  !	Il est conseille de representer la fonction sur un intervalle ne
  !	contenant pas plus d'un extremum.
  !---------------------------------------------------------------------
  integer(kind=4) :: degree         ! degree of representation
  real(kind=8) :: values(0:degree)  ! function at Tchebychev abscissa
  real(kind=8) :: coeff(0:degree)   ! coeffiecients of Tchebychev polynomes
  logical :: error                  ! set if error
  ! Local
  integer(kind=4) :: degmax               ! maximum degree of representation
  parameter (degmax=15)        ! should be enough
  real(kind=8) :: t(0:degmax,0:degmax)  ! polynomes at Tchebychev abscissa
  real(kind=8) :: pi                    ! well known constant
  parameter (pi=3.141592653589793d0)
  integer(kind=4) :: ncoeff               ! number of coefficients
  integer(kind=4) :: j,k                  ! indexes
  real(kind=8) :: y                     ! computation memory
  !
  !  Check parameters
  if (degree.lt.0 .or. degree.gt.degmax) goto 901
  !
  !  Start computations : Tchebychev polynomes at Tchebychev abscissa
  ncoeff = degree+1            ! number of coefficients
  do k = 0,degree              ! loop on abscissa
    t(0,k) = 1.d0              ! X = Tcheb. abscissa
    t(1,k) = cos (dble(2*k+1)*pi/dble(2*ncoeff))
    do j = 2,degree
      t(j,k) = 2.0d0 * t(1,k) * t(j-1,k) - t(j-2,k)
    enddo
  enddo
  !
  !  Coefficients, obtained by scalar product
  do j = 0,degree
    y = 0.d0                   ! initialize coefficient
    do k = 0,degree
      y = y + t(j,k) * values(k)
    enddo
    if (j.gt.0) y = 2.d0 * y   ! ### why ?
    coeff(j) = y / dble(ncoeff)
  enddo
  error = .false.
  return
  901   error = .true.
  return
end subroutine ctcheb
!
subroutine ftcheb (degree,coeff,x,deriv,values,error)
  !---------------------------------------------------------------------
  ! @ private
  !  Calcul d'une fonction et de ses derivees a partir de sa representation
  !  en developpement de polynomes de Tchebychev
  !  Loosely inspired from EPHAUT / BDL / J003 / 81-1
  !  Modified 5 October 1985 - Michel Perault - POM Version 2.0
  !  Input :
  !	DEGREE	degree of representation
  !	COEFF(0:DEGREE)	coeffiecients of Tchebychev polynomes
  !	X	abscissa (between -1.d0 and +1.d0)
  !	DERIV	number of derivatives to compute
  !  Output :
  !	VALUES(0:DERIV)	function and derivatives
  !	ERROR	logical, if improper value of DEGREE, X or DERIV
  !  Notes :
  !	FTCHEB est exprimee dans la meme unite que les coefficients
  !  	Si dt est l'intervalle de representation exprime dans une unite donnee,
  !  	les derivees doivent etre multipliees par (2/dt)**DERIV
  !---------------------------------------------------------------------
  integer(kind=4) :: degree         ! degree of representation
  real(kind=8) :: coeff(0:degree)   ! coeffiecients of Tchebychev polynomes
  real(kind=8) :: x                 ! abscissa (between -1.d0 and +1.d0)
  integer(kind=4) :: deriv          ! number of derivatives to compute
  real(kind=8) :: values(0:deriv)   ! function and derivatives
  logical :: error                  ! set if error
  ! Local
  integer(kind=4) :: degmax               ! maximum degree of representation
  parameter (degmax=15)           ! should be enough
  integer(kind=4) :: dermax               ! maximum derivative which can be computed
  parameter (dermax=3)            ! should be enough
  real(kind=8) :: t(0:degmax,0:dermax)  ! work array, maximum capacity
  integer(kind=4) :: j,k                  ! indexes
  real(kind=8) :: w                     ! 2*X coefficient of lower order polynome in recurrence
  integer(kind=4) :: c                    ! coefficient of lower order derivative in recurrence
  real(kind=8) :: y                     ! computation memory for function and derivatives
  !
  !  Check parameters
  if (degree.lt.0 .or. degree.gt.degmax)  goto 901
  if (deriv.lt.0 .or. deriv.gt.dermax)  goto 901
  if (x.lt.-1.d0 .or. x.gt.+1.d0)  goto 901
  !
  !  Compute Tchebychev polynomes and derivatives at X (recurrence)
  w = x+x
  do k = 0,deriv               ! loop on derivatives
    if (k.eq.0) then           ! init first values, J = 0 and 1
      t(0,k) = 1.d0
      t(1,k) = x
    elseif (k.eq.1) then
      t(0,k) = 0.d0
      t(1,k) = 1.d0
    else
      t(0,k) = 0.d0
      t(1,k) = 0.d0
    endif
    c = k+k
    do j = 2,degree
      t(j,k) = w * t(j-1,k) - t(j-2,k)
      if (k.gt.0) then
        t(j,k) = t(j,k) + c * t(j-1,k-1)
      endif
    enddo
  enddo
  !
  !  Compute function and derivatives
  do k = 0,deriv
    y = 0.d0
    do j = 0,degree
      y = y + t(j,k) * coeff(j)
    enddo
    values(k) = y
  enddo
  error = .false.
  return
  901   error = .true.
  return
end subroutine ftcheb
