bwBASIC/B15B/taki.bas

100 REM   PROGRAM FOR POINTING A TELESCOPE
105 REM            BY T. TAKI
110 REM
111 REM
115 DIM S$(17),B(17),D(17),Q(3,3)
120 DIM V(3,3),R(3,3),X(3,3),Y(3,3)
125 REM
130 REM     STAR DATA
135 FOR J=1 TO 17: READ S$(J),B(J),D(J): NEXT J
140 REM
145 REM     CONSTANTS
150 K=1.002738: G=57.2958
155 Z1=0: Z2=0: Z3=0: REM  MOUNT ERROR, IF ANY <<<<<<<<<
160 REM
165 FOR I=1 TO 2
166 PRINT
170 INPUT "NAME OF BASIC STAR  ";S$(0)
175 INPUT "TIME (MIN)        ";T
180 INPUT "TELESCOPE DIRECTION ";F
185 INPUT "TELESCOPE ELEVATION ";H
195   N=0
200   N=N+1: IF S$(0)=S$(N) THEN 215
205 IF N=17 THEN 170
210   GOTO 200 
215   D(0)=D(N)/G: B(0)=(B(N)-K*T*0.25)/G
220   X(1,I)=COS(D(0))*COS(B(0))
225   X(2,I)=COS(D(0))*SIN(B(0))
230   X(3,I)=SIN(D(0))
235   F=F/G: H=(H+Z3)/G:  GOSUB 750
240   Y(1,I)=Y(1,0): Y(2,I)=Y(2,0): Y(3,I)=Y(3,0)
245 NEXT I
250 REM
255   X(1,3)=X(2,1)*X(3,2)-X(3,1)*X(2,2)
260   X(2,3)=X(3,1)*X(1,2)-X(1,1)*X(3,2)
265   X(3,3)=X(1,1)*X(2,2)-X(2,1)*X(1,2)
270   A=SQR(X(1,3)^2+X(2,3)^2+X(3,3)^2)
275   FOR I=1 TO 3: X(I,3)=X(I,3)/A: NEXT I
280 REM
285   Y(1,3)=Y(2,1)*Y(3,2)-Y(3,1)*Y(2,2)
290   Y(2,3)=Y(3,1)*Y(1,2)-Y(1,1)*Y(3,2)
295   Y(3,3)=Y(1,1)*Y(2,2)-Y(2,1)*Y(1,2)
300   A=SQR(Y(1,3)^2+Y(2,3)^2+Y(3,3)^2)
305   FOR I=1 TO 3: Y(I,3)=Y(I,3)/A: NEXT I
310 REM
311 REM
315 REM   TRANSFORM MATRIX
320 FOR I=1 TO 3: FOR J=1 TO 3
325 V(I,J)=X(I,J)
330 NEXT J: NEXT I
335 GOSUB 650: E=W
340 REM
345 FOR M=1 TO 3: FOR I=1 TO 3: FOR J=1 TO 3
350   V(I,J)=X(I,J)
355   NEXT J: NEXT I
360 FOR N=1 TO 3
365   V(1,M)=0: V(2,M)=0: V(3,M)=0: V(N,M)=1
370   GOSUB 650: Q(M,N)=W/E
375 NEXT N
380 NEXT M
385 REM
390  FOR I=1 TO 3: FOR J=1 TO 3: R(I,J)=0: NEXT J: NEXT I
395  FOR I=1 TO 3: FOR J=1 TO 3: FOR L=1 TO 3
400    R(I,J)=R(I,J)+Y(I,L)*Q(L,J)
405  NEXT L: NEXT J: NEXT I
410 REM
415  FOR M=1 TO 3
420    FOR I=1 TO 3: FOR J=1 TO 3
425  V(I,J)=R(I,J)
430    NEXT J: NEXT I
435    GOSUB 650: E=W
440    FOR N=1 TO 3
445  V(1,M)=0: V(2,M)=0: V(3,M)=0: V(N,M)=1
450  GOSUB 650: Q(M,N)=W/E
455    NEXT N
460  NEXT M
461 REM
462 REM
465 REM       TRANSFORMATION
470 PRINT "     ------"
475 INPUT "OPTION 1 OR 2";E
480    IF E=2 THEN 570
481    IF E = -999 THEN 9999
482    IF E<>1 THEN 475
483 REM
485 REM   CONVERT EQUATORIAL --> TELESCOPE
490 INPUT  "  RIGHT ASCENSION (DEG) ";B(0)
495 INPUT  "  DECLINATION (DEG)     ";D(0)
500 INPUT  "  TIME (MIN)     ";T
505 D(0)=D(0)/G: B(0)=(B(0)-K*T*0.25)/G
510 X(1,1)=COS(D(0))*COS(B(0))
515 X(2,1)=COS(D(0))*SIN(B(0))
520 X(3,1)=SIN(D(0))
525 Y(1,1)=0: Y(2,1)=0: Y(3,1)=0
530 FOR I=1 TO 3: FOR J=1 TO 3
535   Y(I,1)=Y(I,1)+R(I,J)*X(J,1)
540 NEXT J: NEXT I
545 GOSUB 685: F=F/G: H=H/G: GOSUB 785 
550 GOSUB 685: H=H-Z3
555 PRINT USING "TELESCOPE DIRECTION (DEG):####.##";F
560 PRINT USING "TELESCOPE ELEVATION (DEG):####.##";H
565 GOTO 465
566 REM
570 REM  CONVERT TELESCOPE --> EQUATORIAL
575 INPUT "  TELESCOPE DIRECTION (DEG) ";F
580 INPUT "  TELESCOPE ELEVATION (DEG) ";H
585 INPUT "  TIME (MIN)   ";T
590 F=F/G: H=(H+Z3)/G: GOSUB 750
595 X(1,1)=Y(1,0): X(2,1)=Y(2,0): X(3,1)=Y(3,0)
600 Y(1,1)=0: Y(2,1)=0: Y(3,1)=0
605   FOR I=1 TO 3: FOR J=1 TO 3
610 Y(I,1)=Y(I,1)+Q(I,J)*X(J,1)
615   NEXT J: NEXT I
620 GOSUB 685: F=F+K*T*0.25: F=F-INT(F/360)*360
625 PRINT USING "RIGHT ASCENSION (DEG):####.##";F
630 PRINT USING "DECLINATION (DEG):    ####.##";H
635 GOTO 465
640 END
645 REM
650 REM    DETERMINANT SUBROUTINE
655 W=V(1,1)*V(2,2)*V(3,3)+V(1,2)*V(2,3)*V(3,1)
660 W=W+V(1,3)*V(3,2)*V(2,1)
665 W=W-V(1,3)*V(2,2)*V(3,1)-V(1,1)*V(3,2)*V(2,3)
670 W=W-V(1,2)*V(2,1)*V(3,3)
675 RETURN
680 REM
685 REM    ANGLE SUBROUTINE
690 C=SQR(Y(1,1)*Y(1,1)+Y(2,1)*Y(2,1))
695 IF C=0 AND Y(3,1)>0 THEN H=90
700 IF C=0 AND Y(3,1)<0 THEN H=-90
705 IF C<>0 THEN H=ATN(Y(3,1)/C)*G
710 REM
715 IF C=0 THEN F=1000
720 IF C<>0 AND Y(1,1)=0 AND Y(2,1)>0 THEN F=90
725 IF C<>0 AND Y(1,1)=0 AND Y(2,1)<0 THEN F=270
730 IF Y(1,1)>0 THEN F=ATN(Y(2,1)/Y(1,1))*G
735 IF Y(1,1)<0 THEN F=ATN(Y(2,1)/Y(1,1))*G+180
740 F=F-INT(F/360)*360
745 RETURN
746 REM
750 REM       SUBROUTINE
755 Y(1,0)=COS(F)*COS(H)-SIN(F)*(Z2/G)
760   Y(1,0)=Y(1,0)+SIN(F)*SIN(H)*(Z1/G)
765 Y(2,0)=SIN(F)*COS(H)+COS(F)*(Z2/G)
770   Y(2,0)=Y(2,0)-COS(F)*SIN(H)*(Z1/G)
775 Y(3,0)=SIN(H)
780 RETURN
781 REM
785 REM       SUBROUTINE
790 Y(1,1)=COS(F)*COS(H)+SIN(F)*(Z2/G)
795   Y(1,1)=Y(1,1)-SIN(F)*SIN(H)*(Z1/G)
800 Y(2,1)=SIN(F)*COS(H)-COS(F)*(Z2/G)
805   Y(2,1)=Y(2,1)+COS(F)*SIN(H)*(Z1/G)
810 Y(3,1)=SIN(H)
815 RETURN
816 REM
817 REM   STAR LIST
820 DATA "A UMI",  37.960,  89.264
825 DATA "A TAU",  68.980,  16.509
830 DATA "B ORI",  78.634,  -8.202
835 DATA "A AUR",  79.172,  45.998
840 DATA "A ORI",  88.793,   7.407
845 DATA "A CMA", 101.287, -16.716
850 DATA "A GEM", 113.650,  31.888
855 DATA "A CMI", 114.825,   5.225
860 DATA "B GEM", 116.329,  28.026
865 DATA "A LEO", 152.093,  11.967
870 DATA "A VIR", 201.298, -11.161
875 DATA "A BOO", 213.915,  19.183
880 DATA "A SCO", 247.352, -26.432
885 DATA "A LYR", 279.234,  38.784
890 DATA "A AQL", 297.695,   8.868
895 DATA "A CYG", 310.358,  45.280
900 DATA "A PSA", 344.413, -29.622
1000 REM *****************************************
1010 REM    FROM SKY & TELESCOPE, FEBRUARY, 1989,
1020 REM    PAGES 194-196. LINES 760 AND 795
1030 REM    CONTAINED ERRORS AS PRINTED IN THE
1040 REM    MAGAZINE; THEY ARE CORRECTED HERE.
1050 REM *****************************************
9999 END