home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 174 / 174.d81 / farsighted (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  5KB  |  168 lines
  1. 5 poke55,.:poke56,56:clr
  2. 10 dv=peek(186):ifdv<8thendv=8
  3. 15 poke53280,.:poke53281,.:print"[147]"
  4. 16 poke53371,0
  5. 20 ad=49152
  6. 22 sysad:sysad+12
  7. 25 poke53272,29
  8. 30 gosub400
  9. 40 poke53272,31:sysad+9,12
  10. 45 bx$="_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_[157]_"
  11. 50 print"[147][150]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
  12. 55 printbx$;""tab(38)bx$
  13. 60 print"[150]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
  14. 80 print"":printtab(6)"[150] [198] [193] [210] [211] [201] [199] [200] [212] [206] [197] [211] [211] "
  15. 85 printtab(7)"[153] [211][213][206]-[205][207][207][206] [211][197][212][213][208] "
  16. 90 printtab(2)"[156][205]oon [208]hase [159]([198]=0,[209]ts=90,[206]=180):";:l9%=3:gosub1355:am=q9
  17. 100 printtab(2)"[156][205]oon from [218]enith [159]([219]'s): ";:l9%=3:gosub1355:zm=q9
  18. 110 printtab(2)"[156][205]oon's [193]ngular distance [159]([219]'s)";:l9%=3:gosub1355:rm=q9
  19. 120 printtab(2)"[156][211]un from [218]enith [159]([219]'s): ";:l9%=3:gosub1355:zs=q9
  20. 130 printtab(2)"[156][211]un's angular distance [159]([219]'s): ";:gosub1355:rs=q9
  21. 140 printtab(7)"[153] [211][201][212][197] [197][206][214][201][210][207][206][205][197][206][212] "
  22. 150 printtab(2)"[156][210]elative [200]umidity: ";:l9%=6:gosub1355:rh=q9
  23. 160 printtab(2)"[156][212]emperature in [198]ahrenheit: ";:l9%=3:gosub1355:fh=q9
  24. 165 te=(fh-32)*5/9
  25. 170 printtab(2)"[156][217]our [204]atitude: ";:l9%=6:gosub1355:la=q9
  26. 180 printtab(2)"[156][193]ltitude in feet: ";:l9%=5:gosub1355:al=q9
  27. 185 al=al/3.3
  28. 188 printtab(7)"[153] [196][193][212][197] "
  29. 190 printtab(2)"[156][212]he [205]onth- [159](1-12):";:l9%=2:gosub1355:m=q9
  30. 200 printtab(2)"[156][212]he [217]ear: ";:l9%=4:gosub1355:y=q9
  31. 210 sn=1:rem snellen ratio (20/20=1, good 20/10=2
  32. 215 printtab(7)"[153] [207][194][202][197][195][212]'[211] [204][207][195][193][212][201][207][206] "
  33. 220 printtab(2)"[156][218]enith distance [159]([219]'s):";:l9%=4:gosub1355:z=q9
  34. 222 poke214,20:print:printtab(9)"[158][201]s this correct? [154][217][150]/[154][206]":poke198,0
  35. 223 geta$:ifa$<>"y"anda$<>"n"then223
  36. 225 ifa$="n"then40
  37. 229 print"[147]":sysad+9,14
  38. 230 print"[159]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
  39. 232 printbx$:print""tab(38)bx$
  40. 235 print"[159]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
  41. 248 gosub1000:rem extinction
  42. 249 gosub2000:rem sky
  43. 250 sysad+9,14:rem visual limiting magnitude
  44. 260 bl=b(3)/1.11e-15:rem in nanolamberts
  45. 270 ifbl>1500then300
  46. 280 c1=10^-9.8:c2=10^-1.9
  47. 290 goto310
  48. 300 c1=10^-8.350001:c2=10^-5.9
  49. 310 th=c1*((1+sqr(c2*bl))^2):rem in foot-candles
  50. 320 mn=-16.57-2.5*(log(th)/log(10))-dm(3)+5*(log(sn)/log(10))
  51. 340 print:printtab(2)"[150]-[153][211]ky [194]rightness ([155]n[204][153])[158]:";bl
  52. 350 printtab(2)"[150]-[153][204]imiting [205]agnitude[158]:";mn
  53. 360 gosub13000
  54. 365 restore:print"[147]":goto30
  55. 400 fori=1to5:readwa(i):nexti
  56. 410 data.365,.44,.55,.7,.9
  57. 420 fori=1to5:readmo(o):nexti
  58. 425 data-10.93,-10.45,-11.05,-11.9,-12.7
  59. 430 rd=(NULL)/180
  60. 435 return
  61. 1000 rem extinction subroutine
  62. 1010 fori=1to5:readoz(i):nexti
  63. 1020 data0,0,.031,.008,0
  64. 1030 fori=1to5:readwt(i):nexti
  65. 1040 data.074,.045,.031,.02,.015
  66. 1050 lt=la*rd
  67. 1060 ra=(m-3)*30*rd
  68. 1070 sl=la/abs(la)
  69. 1080 rem airmass for each component
  70. 1090 zz=z*rd
  71. 1100 xg=1/(cos(zz)+.0286*exp(-10.5*cos(zz)))
  72. 1110 xa=1/(cos(zz)+.0123*exp(-24.5*cos(zz)))
  73. 1120 xo=1/sqr(1-(sin(zz)/(1+(20/6378)))^2)
  74. 1130 rem ubvri extinction for each component
  75. 1140 fori=1to5
  76. 1150 kr=.1066*exp(-1*al/8200)*((wa(i)/.55)^-4)
  77. 1160 ka=.1*((wa(i)/.55)^-1.3)*exp(-1*al/1500)
  78. 1170 ka=ka*((1-.32/log(rh/100))^1.33)*(1+sl*sin(ra))
  79. 1180 ko=oz(i)*(3+.4*(lt*cos(ra)-cos(3*lt)))/3
  80. 1190 kw=wt(i)*.94*(rh/100)*exp(te/15)*exp(-1*al/8200)
  81. 1200 k(i)=kr+ka+ko+kw
  82. 1210 dm(i)=kr*xg+ka*xa+ko*xo+kw*xg
  83. 1220 nexti
  84. 1230 rem write results and return
  85. 1240 print"":printtab(2)"[153] [193][201][210][205][193][211][211] [146][159]-[199]as-  [158]-[193]erosol-  [154]-[207]zone-:"
  86. 1250 printtab(1)"[159]"xg,"[158]"xa
  87. 1255 printtab(1)"[154]"xo
  88. 1260 printtab(2)"[153] [197]xtinction [195]oefficients [146] [154][213]-[159][194]-[214]-[150][210]-[129][201]:"
  89. 1270 printtab(1)"[154]"k(1),"[159]"k(2)
  90. 1273 printtab(1)""k(3),"[150]"k(4)
  91. 1275 printtab(1)"[129]"k(5)
  92. 1280 printtab(2)"[153] [212]otal [197]xtinction [146] [154][213]-[159][194]-[214]-[150][210]-[129][201]:"
  93. 1290 printtab(1)"[154]"dm(1),"[159]"dm(2)
  94. 1292 printtab(1)""dm(3),"[150]"dm(4)
  95. 1294 printtab(1)"[129]"dm(5)
  96. 1295 sysad+9,4
  97. 1300 return
  98. 1355 q9$="":poke198,.
  99. 1360 geta$
  100. 1365 poke646,rnd(1)*15+1:print"*[157]";:ifa$=""then1360
  101. 1370 ifa$=chr$(13)thenprint" ":q9=val(q9$):return
  102. 1375 if(a$=chr$(20)andlen(q9$))thenq9$=left$(q9$,len(q9$)-1):goto1397
  103. 1380 iflen(q9$)>=l9%thensysad+9,6:goto1360
  104. 1385 if(a$>="0"anda$<="9")ora$="."ora$="-"then1390
  105. 1387 goto1360
  106. 1390 q9$=q9$+a$
  107. 1395 print"[158]"a$;:sysad+9,13:goto1360
  108. 1397 print" [157][157] [157]";:goto1360
  109. 2000 rem sky routine
  110. 2010 fori=1to5:readbo(i):nexti
  111. 2020 data8e-14,7e-14,1e-13,1e-13,3e-13
  112. 2030 fori=1to5:readcm(i):nexti
  113. 2040 data1.36,.91,0,-.76,-1.17
  114. 2050 fori=1to5:readms(i):nexti
  115. 2060 data-25.96,-26.09,-26.74,-27.26,-27.55
  116. 2070 x=1/(cos(zz)+.025*exp(-11*cos(zz))):rem air mass
  117. 2080 xm=1/(cos(zm*rd)+.025*exp(-11*cos(zm*rd))):rem air mass moon
  118. 2090 ifzm>90thenxm=40
  119. 2100 xs=1/(cos(zs*rd)+.025*exp(-11*cos(zs*rd))):rem air mass sun
  120. 2110 ifzs>90thenxs=40
  121. 2120 fori=1to5
  122. 2130 rem dark night sky brightness
  123. 2140 bn=bo(i)*(1+.3*cos(6.283*(y-1992)/11))
  124. 2150 bn=bn*(.4+.6/sqr(1-.96*((sin(zz))^2)))
  125. 2160 bn=bn*(10^(-.4*k(i)*x))
  126. 2170 rem moonlight brightness
  127. 2180 mm=-12.73+.026*abs(am)+4e-09*(am^4):rem moon mag in v
  128. 2190 mm=mm+cm(i):rem moon mag
  129. 2200 c3=10^(-.4*k(i)*xm)
  130. 2210 fm=6.2e+07*(rm^-2)+(10^(6.16-rm/40))
  131. 2220 fm=fm+(10^5.36)*(1.06+((cos(rm*rd))^2))
  132. 2230 bm=10^(-.4*(mm-mo(i)+43.27))
  133. 2240 bm=bm*(1-10^(-.4*k(i)*x))
  134. 2250 bm=bm*(fm*c3+440000*(1-c3))
  135. 2260 rem twight brightness
  136. 2270 hs=90-zs:rem height of sun
  137. 2280 bt=10^(-.4*(ms(i)-mo(i)+32.5-hs-(z/(360*k(i)))))
  138. 2290 bt=bt*(100/rs)*(1-10^(-.4*k(i)))
  139. 2300 rem daylight brightness
  140. 2310 c4=10^(-.4*k(i)*xs)
  141. 2320 fs=6.2e+07*(rs^-2)+(10^(6.15-rs/40))
  142. 2330 fs=fs+(10^5.36)*(1.06+((cos(rs*rd))^2))
  143. 2340 bd=10^(-.4*(ms(i)-mo(i)+43.27))
  144. 2350 bd=bd*(1-10^(-.4*k(i)*x))
  145. 2360 bd=bd*(fs*c4+440000*(1-c4))
  146. 2370 rem total sky brightness
  147. 2380 ifbd>btthen2410
  148. 2390 b(i)=bn+bd
  149. 2400 goto2420
  150. 2410 b(i)=bn+bt
  151. 2420 ifzm<90thenb(i)=b(i)+bm
  152. 2430 nexti
  153. 2440 printtab(2)"[153] [211]ky [194]rightness [146] [154][213]-[159][194]-[214]-[150][210]-[129][201]:"
  154. 2450 printtab(1)"[154]"b(1),"[159]"b(2)
  155. 2452 printtab(1)""b(3),"[150]"b(4)
  156. 2455 printtab(1)"[129]"b(5)
  157. 2460 return
  158. 10000 d=peek(186):n$="0:farsighted":open15,d,15,"s"+n$:close15:saven$,d:end
  159. 13000 poke214,20:print:printtab(8)"(1) [212]ry another one
  160. 13010 [153][163]8)"(2) (NULL)o (NULL)(NULL)right$(NULL)val(NULL)(NULL)val (NULL)enu
  161. 13020 poke198,0
  162. 13030 geta$:ifa$<"1"ora$>"2"then13030
  163. 13040 ifa$="1"thenreturn
  164. 13050 sysad+15
  165. 13060 print"[147][144]load"chr$(34)"b.universe iii"chr$(34)","dv
  166. 13070 print"run28"
  167. 13080 poke631,13:poke632,13:poke198,2:end
  168.