1000 ' ================ PRECESS.BAS =====================
1010 '   Written for Microsoft BASIC Version 5.211
1020 'Published in ASTRONOMY, August 1984, Pages 74-77
1030 '         By J. P. POOL and R. L. Berry
1040 '
1050 PRINT "This program computes rigorous precession"
1060 PRINT "from a string representation of RA and DEC"
1070 PRINT "and returns a string representation of the"
1080 PRINT "precessed coordinates."
1090 '
1100 R=.01745329#
1110 '
1120 ' ====== compute the constants of precession ======
1130 '
1140 INPUT "INITIAL EPOCH";IN
1150 INPUT "  FINAL EPOCH";FI
1160 T1=FI-IN
1170 T=T1/100
1180 Z0=((2305.65*T)+(.302*T*T)+(.018*T*T*T))
1190 Z1=R*(Z0/3600)
1200 Z=(Z0+(.791*T*T))/3600
1210 TH=R*(((2003.829#*T)-(.426*T*T)-(.042*T*T*T))/3600)
1220 '
1230 ' ==== input coordinates and proper motion ====
1240 '
1250 PRINT "INITIAL RA: HH MM SS.F"
1260 INPUT"          ";RA$
1270 PRINT "INITIAL DC: +DD MM SS"
1280 INPUT"          ";DEC$
1290 INPUT "PROPER MOTION: <MUra,MUdec or 0,0>";MURA,MUDC
1300 MURA=T1*15*MURA/3600:MUDC=T1*MUDC/3600
1310 IRA=VAL(MID$(RA$,1,2))
1320 IRA=IRA+VAL(MID$(RA$,4,2))/60
1330 IRA=IRA+VAL(MID$(RA$,7,4))/3600
1340 IRA=15*IRA
1350 IDC=VAL(MID$(DEC$,2,2))
1360 IDC=IDC+VAL(MID$(DEC$,5,2))/60
1370 IDC=IDC+VAL(MID$(DEC$,8,2))/3600
1380 IF MID$(DEC$,1,1)="-" THEN IDC=-IDC
1390 AL0=R*(IRA+MURA)
1400 DL0=R*(IDC+MUDC)
1410 '
1420 ' ======== precess the coordinates ===============
1430 '
1440 A=COS(DL0)*SIN(AL0+Z1)
1450 B=(COS(TH)*COS(DL0)*COS(AL0+Z1))-(SIN(TH)*SIN(DL0))
1460 C=(SIN(TH)*COS(DL0)*COS(AL0+Z1))+(COS(TH)*SIN(DL0))
1470 ALPMZ= ATN(A/B)/R
1480 AL=(ALPMZ+Z)/15
1490 IF B<0 AND A>0 THEN AL=AL+12
1500 IF B<0 AND A<0 THEN AL=AL+12
1510 IF B>0 AND A<0 THEN AL=AL+24
1520 DL=ATN(C/SQR(1-C*C))/R
1530 '
1540 ' ==== convert decimal RA to HH MM SS.F string ====
1550 '
1560 RAH=FIX(AL)
1570 RAM=INT(60*(AL-RAH))
1580 RAS=INT(3600*(AL-RAH-(RAM/60)))
1590 RAF=INT(36000!*(AL-RAH-(RAM/60)-(RAS/3600)))
1600 RAH$=STR$(RAH):RAM$=STR$(RAM)
1610 RAS$=STR$(RAS):RAF$=STR$(RAF)
1620 IF RAH<10 THEN MID$(RAH$,1)="0"
1630 IF LEN(RAH$)=3 THEN RAH$=MID$(RAH$,2,2)
1640 IF RAM<10 THEN MID$(RAM$,1)="0"
1650 IF LEN(RAM$)=2 THEN RAM$=" "+RAM$
1660 IF RAS<10 THEN MID$(RAS$,1)="0"
1670 IF LEN(RAS$)=2 THEN RAS$=" "+RAS$
1680 PRA$=RAH$+RAM$+RAS$+RAF$
1690 MID$(PRA$,9)="."
1700 '
1710 ' ==== convert decimal DEC to DD MM SS string ====
1720 '
1730 IF DL<0 THEN SG$="-" ELSE SG$="+"
1740 DL=ABS(DL)
1750 DD=FIX(DL)
1760 DM=INT(60*(DL-DD))
1770 DS=INT(3600*(DL-DD-(DM/60)))
1780 DD$=STR$(DD):DM$=STR$(DM):DS$=STR$(DS)
1790 IF DD<10 THEN MID$(DD$,1)="0"
1800 IF LEN(DD$)=3 THEN DD$=MID$(DD$,2,2)
1810 IF DM<10 THEN MID$(DM$,1)="0"
1820 IF LEN(DM$)=2 THEN DM$=" "+DM$
1830 IF DS<10 THEN MID$(DS$,1)="0"
1840 IF LEN(DS$)=2 THEN DS$=" "+DS$
1850 PDC$=SG$+DD$+DM$+DS$
1860 '
1870 ' ==== print epochs and coordinate strings ====
1880 '
1890 PRINT "Epoch";IN;RA$+"  "+DEC$
1900 PRINT "Epoch";FI;PRA$+"  "PDC$
1910 PRINT
1920 INPUT "Another? <S>ame or <N>ew epoch or <E>xit";ANS$
1930 IF ANS$="S" OR ANS$="s" THEN GOTO 1230
1940 IF ANS$="N" OR ANS$="n" THEN GOTO 1140
1950 RUN "ASTRMENU.BAS"