PROGRAM XPRECESS
C
C     EXERCISE DRIVER FOR SUBROUTINE PRECESS.FOR
C
C     B. KNAPP, 93.06.16
C
C
C     RCS DATA
C     
C     $Header$
C     
C     $Log$
C
C
      IMPLICIT NONE
C
      REAL*8  H0, M0, S0, D0, AM0, AS0, RA0, DEC0,
     &               DS0,         DAS0,DRA0,DDEC0,
     &                S1,          AS1, RA1(0:1), DEC1(0:1), ADEC,
     &               DS1,         DAS1,DRA1,DDEC1, J0, J1, NY
      INTEGER*4 H1,M1,D1,AM1,J
C
      REAL*8 D2R
      PARAMETER (D2R=3.14159265358979324D0/180.D0)
C
      J0 = 2000.0D0
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
      RA0 =  (H0 +  M0/60.D0 +  S0/3600.D0)*15.D0*D2R
      DEC0 = 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
      DRA0 = ( DS0/3600.D0)*15.D0*D2R
      DDEC0 = DAS0/3600.D0*D2R
C
      WRITE(*,40) '  Final epoch? '
   40 FORMAT(/A$)
      READ(*,*) J1
      NY = J1-J0
C
      DO J=0,1
         RA0 = RA0+J*NY*DRA0
         DEC0 = DEC0+J*NY*DDEC0
         CALL PRECESS(J0,J1,RA0,DEC0,RA1(J),DEC1(J))
      ENDDO
C
      DRA1 = (RA1(1)-RA1(0))/D2R*240.D0/NY
      DDEC1 = (DEC1(1)-DEC1(0))/D2R*3600.D0/NY
C
      RA1(1) = RA1(1)/D2R*240.D0
      H1 = RA1(1)/3600.D0
      RA1(1) = RA1(1)-3600*H1
      M1 = RA1(1)/60.D0
      S1 = RA1(1)-60*M1
C
      ADEC = ABS(DEC1(1))/D2R*3600.D0
      D1 = ADEC/3600.D0
      ADEC = ADEC - 3600*D1
      IF (DEC1(1) .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)
      WRITE(*,30)
      WRITE(*,70) DRA1
   70 FORMAT('    R.A. (sec/yr):',SP,F8.4)
      WRITE(*,80) DDEC1
   80 FORMAT('    Dec. (arcsec/yr):',SP,F7.3)
C
      GOTO 1
      END