PROGRAM XEPHEM_table
C
C     EXERCISE DRIVER FOR SUBROUTINE EPHEM_table
C
C     B. KNAPP, 1994-06-14, 2000-10-12, 2002-03-19
C
C
C     RCS DATA
C     
C     $Header$
C     
C     $Log$
C
C
      IMPLICIT NONE
C
      REAL*8 DAY, JD, pv1(6), pv2(6), dpv2(6), noon, f
      INTEGER*4 P, YR, MON, STATUS1, STATUS2, seed, i, j
      INTEGER*4 TRUE, APPARENT, EQUATORIAL, ECLIPTIC, HELIOCENTRIC,
     &   SPHERICAL, RECTANGULAR
      PARAMETER (TRUE=1, APPARENT=2, EQUATORIAL=1, ECLIPTIC=2,
     &   HELIOCENTRIC=3, SPHERICAL=1, RECTANGULAR=2)
C
C     EXTERNAL FUNCTIONS, SUBROUTINES
      real*4 ran1
      REAL*8 TD2UT
      EXTERNAL TD2UT, YMD2JD, EPHEM, ephem_table, ran1
C
      seed = -1234567
C
    1 CONTINUE
      WRITE(*,'(/A$)') ' Planet, Year, month, day? '
      READ(*,*) P, YR, MON, DAY
C
C   2 CONTINUE
C     WRITE(*,'( A$)') ' Body (0,...,9,10, for Sun,...,Pluto,Moon)? '
C     READ(*,*) P
      IF ( P .LT. 0 .OR. 10 .LT. P ) GOTO 1
C
!     For some random times on the given day, call both ephem_table
!     and ephem, and compare results
      noon = dble(int(day))+0.5d0
      call ymd2jd(yr, mon, noon, jd)
      call ephem_table(jd, p, apparent, equatorial, rectangular,
     &   pv2, dpv2, status2) ! to initialize
!
      do i=1,4
         f = dble(ran1(seed))*1.25d0 - 0.625d0
         call ymd2jd(yr, mon, noon+f, jd)
         CALL EPHEM( JD, P, APPARENT, EQUATORIAL, RECTANGULAR, 
     &      pv1, STATUS1 )
         call ephem_table(jd, p, apparent, equatorial, rectangular,
     &      pv2, dpv2, status2)
C
C        PRINT THE RESULTS
         write(*,'(i4,f16.6,2i6/(20x,2f14.8,1p,2e14.4,0p))') i, jd,
     &      status1, status2, (pv1(j), pv2(j), (pv1(j)-pv2(j))/pv1(j), 
     &      dpv2(j)/pv1(j), j=1,6)
      enddo
      GOTO 1
      END