Home   Jensen Archive   jWiki   Jensen News   Jensen Cloud   Jensen Programming   Jensen Family Tree   JensenDiary

KOMPAS

The Digital Almanak

A 16 bit QBASIC program to calculate sun elevation from an Earth position.

It was made by Kai William Jensen (my grandfather) in the mid 90's for a payment bonus as he worked on a ship.

To run it you'll have to place the Kompas folder directly on C:/ and run C:/Kompas/AUTOEXEC.BAT.

You can also try this translation to JavaScript of the program

Note: It will change your encode and keyboard to danish.

Compatible with

KOMPAS.BAS

  1. 10 DEFDBL A-Z
  2. 20 PI = 3.141592654#
  3. 30 DEF FNSINUS (X) = SIN(X * PI / 180)
  4. 40 DEF FNTANG (X) = TAN(X * PI / 180)
  5. 50 DEF FNCOSIN (X) = COS(X * PI / 180)
  6. 60 DEF FNACS (X) = ATN(SQR(1 - X * X) / X) * 180 / PI - 90 * (SGN(X) - 1)
  7. 70 DEF FNASN (X) = ATN(X / SQR(1 - X * X)) * 180 / PI
  8. 80 COLOR 14, 6, 4
  9. 90 CLS
  10. 100 PRINT "Almanak og kompasretning"
  11. 110 INPUT "Dato YY.MMDD"; E
  12. 120 V = E
  13. 130 INPUT "Tid hh.mmss"; K
  14. 140 Y = INT(E)
  15. 150 M = INT((E - Y) * 100)
  16. 160 D = E * 10000 - (INT(100 * E)) * 100
  17. 170 H = INT(K): U = INT((K - H) * 100): S = K * 10000 - (INT(100 * K)) * 100
  18. 180 P = SGN(Y / 4 - INT(Y / 4))
  19. 190 Z = INT((Y - 84) * 365.25 + .75)
  20. 200 N = (M - 1) * 30
  21. 210 IF M = 2 THEN N = N + 1
  22. 220 IF M > 2 THEN N = N + CINT(.6 * (M - 3) - P)
  23. 230 N = Z + N + D - 1
  24. 240 E = H * 3600# + U * 60 + S
  25. 250 T = N * 86400# + E
  26. 260 A = 31556926#
  27. 270 T = A * (T / A - INT(T / A))
  28. 280 F = .01674: I = 360 / A * (T - 252000#): J = I
  29. 290 L = J - 180 / PI * F * FNSINUS(J)
  30. 300 J = J + I - L
  31. 310 IF ABS(I - L) < .000001 THEN 330
  32. 320 GOTO 290
  33. 330 VV = (FNCOSIN(J) - F) / (1 - F * FNCOSIN(J))
  34. 340 IF VV = 0 THEN O = 90: GOTO 360
  35. 350 O = FNACS(VV)
  36. 360 IF I < 0 THEN O = -O
  37. 370 IF I > 180 THEN O = 360 - O
  38. 380 O = O - 77.28442: R = 23.447
  39. 390 B = FNASN(FNSINUS(R) * FNSINUS(O))
  40. 400 Q = ABS(B): GOSUB 590
  41. 410 IF B < 0 THEN PRINT "Dkl = S"; X; "�"; P; "'"
  42. 420 IF B >= 0 THEN PRINT "Dkl = N"; X; "�"; P; "'"
  43. 430 W = 180 / PI * ATN(FNCOSIN(R) * FNTANG(O))
  44. 440 IF O > 90 THEN W = W + 180
  45. 450 IF O > 270 THEN W = W + 180
  46. 460 C = (T - 6863040!) / A * 360 - W - 1.867
  47. 470 GG = (E / 240 + 180 + C) / 360
  48. 480 G = (GG - INT(GG)) * 360
  49. 490 Q = G
  50. 500 GOSUB 590
  51. 510 PRINT "GHA ="; X; "�"; P; "'"
  52. 520 Q = 12 - C / 15
  53. 530 GOSUB 590
  54. 540 PRINT "Mer. pass "; X; "t"; P; "m"
  55. 550 P = X * 100 + P
  56. 560 D = B
  57. 570 A = V
  58. 580 GOTO 600
  59. 590 X = INT(Q): P = (INT(600 * (Q - INT(Q)) + .5)) / 10: RETURN
  60. 600 IF P < 1200 THEN P = P + 40
  61. 610 PRINT "Dato"; A
  62. 620 PRINT "Hvor foreg�r kompasretningen i n�rheden af? Indtast:"
  63. 630 PRINT "1 for Marstal"
  64. 640 PRINT "2 for �r�sk�bing"
  65. 650 PRINT "3 for S�by"
  66. 660 PRINT "4 for Bagenkop"
  67. 670 PRINT "5 for andre steder"
  68. 680 INPUT K
  69. 690 ON ERROR GOTO 710
  70. 700 GOTO 730
  71. 710 IF ERR = 25 THEN COLOR 15, 6: PRINT "Printeren er ikke t�ndt eller tilsluttet": COLOR 14, 6
  72. 720 RESUME 730
  73. 730 INPUT "�nsker du udskrift? J/N "; UD$
  74. 735 IF UD$ = "j" THEN LPRINT : LPRINT : LPRINT
  75. 740 MV = 0: PRINT "Dato "; A: IF UD$ = "j" THEN LPRINT "Dato "; A
  76. 750 IF K = 1 THEN L = 17.7: PRINT "MARSTAL": B = 54.85: IF UD$ = "j" THEN LPRINT "MARSTAL"
  77. 760 IF K = 2 THEN L = 18.3: PRINT "�R�SK�BING": B = 54.9: IF UD$ = "j" THEN LPRINT "�R�SK�BING"
  78. 770 IF K = 3 THEN L = 18.9: PRINT "S�BY": B = 54.95: IF UD$ = "j" THEN LPRINT "S�BY"
  79. 780 IF K = 4 THEN L = 17.2: PRINT "BAGENKOP": B = 54.75: IF UD$ = "j" THEN LPRINT "BAGENKOP"
  80. 790 IF K > 4.5 THEN INPUT "Bredde i GRADER , MINUTER"; BG, BM: INPUT "L�ngde i GRADER , MINUTER"; LG, LM: INPUT "Misvisning i grader"; MV
  81. 800 IF K > 4.5 THEN B = BG + BM / 60: L = (15 - (LG + LM / 60)) * 4
  82. 810 IF (K > 4.5) AND (UD$ = "j") THEN LPRINT "Bredde"; BG; "�"; BM; "'", "L�ngde"; LG; "�"; LM; "'", "Misvisning"; MV; "�"
  83. 820 INPUT "Start GMT (hh(.mm))"; S
  84. 830 INPUT "Slut GMT (hh(.mm))"; E
  85. 840 PRINT " GMT Mv. pejling"
  86. 850 IF UD$ = "j" THEN LPRINT " GMT Mv. pejling"
  87. 860 G = 0
  88. 870 S = S + 1
  89. 880 E = E + 1
  90. 890 DEFSNG I
  91. 900 FOR I = S TO E STEP .01
  92. 910 IF (I - INT(I)) >= .6 THEN I = INT(I + 1)
  93. 920 F = I
  94. 930 F = INT(F) + (F - INT(F)) * 5 / 3
  95. 940 T = F - L / 60 - (P - 1200) / 60
  96. 950 T = 180 + 15 * T
  97. 960 IF T >= 360 THEN T = T - 360
  98. 970 C = FNCOSIN(T) * FNSINUS(B) - FNCOSIN(B) * FNTANG(D)
  99. 980 IF ABS(C) < .0001 THEN GOTO 1090
  100. 990 V = 180 / PI * ATN(FNSINUS(T) / C)
  101. 1000 IF T < 180 THEN GOTO 1040
  102. 1010 IF V > 0 THEN GOTO 1070
  103. 1020 Z = V + 180
  104. 1030 GOTO 1110
  105. 1040 IF V >= 0 THEN Z = 180 + V: GOTO 1110
  106. 1050 Z = 360 + V
  107. 1060 GOTO 1110
  108. 1070 Z = V
  109. 1080 GOTO 1110
  110. 1090 IF T < 180 THEN Z = 90
  111. 1100 Z = 270
  112. 1110 Z = INT(Z - MV + .5)
  113. 1120 IF ABS(Z - G) < 1 THEN GOTO 1160
  114. 1130 PRINT INT((I - 1) * 100); " "; Z
  115. 1140 IF UD$ = "j" THEN LPRINT INT((I - 1) * 100); " "; Z
  116. 1150 G = Z
  117. 1160 NEXT I
  118. 1170 INPUT "Listen er f�rdig. Vil du forts�tte? J/N "; FO$
  119. 1180 IF FO$ = "j" THEN GOTO 10
  120. 1190 IF FO$ = "n" THEN COLOR 14, 1: CLS : SYSTEM
  121. 1200 GOTO 1170
  122. 1210 END