PROGRAM XSTAR_J2000
C
C     EXERCISE DRIVER FOR SUBROUTINE STAR_J2000
C
C     B. KNAPP, 1993-06-22, 2001-04-25
C
C
C     RCS DATA
C     
C     $Header$
C     
C     $Log$
C
C
      IMPLICIT NONE
C
      REAL*8    H0, M0, S0, D0, AM0, AS0,
     &                 DS0,         DAS0,
     &                  S1,          AS1, RA1, ADEC
      REAL*8    PLACE_J2000(2), MOTION_J2000(2), PLACE(2),
     &          DAY, JD, JDE, EPOCH
C
      INTEGER*4 H1, M1,     D1, AM1, YEAR, MONTH
C
      REAL*8 D2R
      PARAMETER (D2R=3.14159265358979324D0/180.D0)
C
C     FUNCTIONS
      REAL*8 DELTAT
C
C
    1 CONTINUE
      WRITE(*,10)
   10 FORMAT(/'  Initial epoch 2000.0')
      WRITE(*,20) '    R.A. (h,m,s)? '
   20 FORMAT(A$)
      READ(*,*) H0,M0,S0
      WRITE(*,20) '    Dec. (d,'',")? '
      READ(*,*) D0,AM0,AS0
C
      PLACE_J2000(1) = (H0 +  M0/60.D0 +  S0/3600.D0)*15.D0*D2R
      PLACE_J2000(2) = SIGN((ABS(D0) + AM0/60.D0 + AS0/3600.D0)*D2R,D0)
C
      WRITE(*,30)
   30 FORMAT( '  Proper motion in' )
      WRITE(*,20) '    R.A. (sec/yr)? '
      READ(*,*) DS0
      WRITE(*,20) '    Dec. (arcsec/yr)? '
      READ(*,*) DAS0
C
      MOTION_J2000(1) = (DS0/3600.D0)*15.D0*D2R
      MOTION_J2000(2) = DAS0/3600.D0*D2R
C
C     FINAL EPOCH
      WRITE(*,'(/A$)') '  Year, month, day (UT)? '
      READ(*,*) YEAR, MONTH, DAY
      CALL YMD2JD(YEAR,MONTH,DAY,JD)
      EPOCH = 2000.0D0 + (JD-2451545.D0)/365.25D0
      JDE = JD  !+DELTAT(EPOCH)/86400.D0
C
C     COMPUTE APPARENT PLACE FOR GIVEN EPOCH
      CALL STAR_J2000(PLACE_J2000,MOTION_J2000,JDE,PLACE)
C
C     WRITE RESULT
C
      RA1 = PLACE(1)/D2R*240.D0
      H1 = RA1/3600.D0
      RA1 = RA1-3600*H1
      M1 = RA1/60.D0
      S1 = RA1-60*M1
C
      ADEC = ABS(PLACE(2))/D2R*3600.D0
      D1 = ADEC/3600.D0
      ADEC = ADEC - 3600*D1
      IF (PLACE(2) .LT. 0.) D1 = -D1
      AM1 = ADEC/60.D0
      AS1 = ADEC-60*AM1
C
      WRITE(*,50) H1,M1,S1
   50 FORMAT('    R.A. (h,m,s):',I3,I3,F7.3)
      WRITE(*,60) D1,AM1,AS1
   60 FORMAT('    Dec. (d,'',"):',SP,I3,S,I3,F6.2)
C
      GOTO 1
      END