10 REM PROGRAM QSUN
20 DIM Z(250), AZ(250), IRR(250, 3)
30 CLS : SCREEN 12
40 WINDOW
50 PI = 3.141593: DRC = PI / 180
60 GOSUB 3000
140 LOCATE 3, 18: PRINT "THIS PROGRAM COMPUTES AND GRAPHS SUNSHINE DATA"
150 LOCATE 4, 29: PRINT "FOR ANY DAY AND LATITUDE"
170 LOCATE 7, 25: PRINT "FIRST, PICK A MONTH FROM 1 TO 12"
180 LOCATE 9, 29: PRINT "1=JAN  2=FEB .... 12=DEC"
190 COLOR 12: LOCATE 11, 32: INPUT "MONTH NUMBER = ", M
200 LOCATE 14, 30: INPUT "DAY OF THE MONTH = ", DYN
210 D = (30 * (M - 1) - 171 + DYN) * DRC
220 LOCATE 17, 29: INPUT "LATITUDE, DEGREES = ", PHD
225 IF PHD = 90 THEN PHD = 89.95
227 PH = PHD
230 COLOR 15: LOCATE 20, 28: PRINT "TYPE S FOR SOUTH LATITUDE"
240 LOCATE 21, 28: PRINT "TYPE N FOR NORTH LATITUDE"
250 COLOR 12: LOCATE 23, 33: INPUT "YOUR CHOICE = ", LT$: COLOR 15
260 IF LT$ = "S" OR LT$ = "s" THEN LSN = -1 ELSE LSN = 1
270 GOSUB 2110
280 CLS : GOSUB 3000
290 DD = D - 10 * DRC
300 OBL = 23.45 * DRC
310 PH = PH * DRC * LSN
320 APRJ = 15 * DRC * LSN: CPRJ = .12: REM PROJECTION CONSTANTS
330 CX = CPRJ * SIN(APRJ): CY = CPRJ * COS(APRJ)
340 DS = 149.5
350 DSE = DS + 2.5 * COS(DD)
360 DR = (DSE / DS)
370 LOCATE 3, 25: PRINT "ASTRONOMICAL PARAMETERS FOR"
380 ON M GOTO 2140, 2150, 2160, 2170, 2180, 2190, 2200, 2210, 2220, 2230, 2240, 2250
390 LOCATE 4, 25: PRINT MN$; DYN; SPC(6); "LATITUDE"; PHD; LT$
410 LOCATE 10, 5: PRINT "DISTANCE TO SUN (10^6 KM) = "; DSE
420 SC = 1367 * DR ^ (-2)
430 LOCATE 13, 5: PRINT "DIRECT SOLAR INTENSITY (W/M^2) = "; CINT(SC)
440 DEC = OBL * COS(D)
450 LOCATE 16, 5: PRINT "DECLINATION (ø)= "; DEC / DRC
460 A = COS(DEC) * COS(PH)
470 B = SIN(DEC) * SIN(PH)
480 AB = COS(DEC) * SIN(PH)
490 BA = SIN(DEC) * COS(PH)
500 TT = -TAN(DEC) * TAN(PH)
510 IF TT >= 1 THEN TSS = 0: LOCATE 19, 32: PRINT "24 HOURS NIGHT": GOTO 750
520 IF TT <= -1 THEN TSS = 12: LOCATE 19, 33: PRINT "24 HOURS DAY": GOTO 565
530 TSS = -ATN(TT / SQR(-TT * TT + 1)) * 12 / PI + 6
540 TSM$ = STR$(CINT((TSS - INT(TSS)) * 60))
550 IF INT(TSS) < 1 THEN TSH$ = "12" ELSE TSH$ = STR$(INT(TSS))
560 LOCATE 19, 5: PRINT "SUNSET TIME = "; TSH$ + ":" + TSM$
565 COLOR 12
570 LOCATE 23, 17: PRINT "HIT ANY KEY FOR HOURLY ZENITH AND AZIMUTH ANGLES"
575 COLOR 15
580 WHILE INKEY$ = "": WEND
590 CLS : GOSUB 3000: LOCATE 3, 5
600 PRINT "HOUR"; TAB(15); "ZENITH ANGLE"; TAB(33); "AZIMUTH ANGLE"
601 LOCATE 10, 55: PRINT "270ø  W       E   90ø"
602 LOCATE 6, 65: PRINT "0ø"
603 LOCATE 8, 65: PRINT "N"
604 LOCATE 14, 64: PRINT "180ø"
605 LOCATE 12, 65: PRINT "S"
606 CIRCLE (516, 150), 50
607 LINE (496, 150)-(536, 150)
608 LINE (516, 130)-(516, 170)
609 LOCATE 3, 58: PRINT "KEY TO AZIMUTH"
610 FOR I = INT(13 - TSS) TO INT(12 + TSS)
620 H = I * PI / 12 - PI
630 CZ = B + A * COS(H)
640 IF CZ = 1 THEN Z = 0: GOTO 660
650 Z = -ATN(CZ / SQR(-CZ * CZ + 1)) / DRC + 90
660 Q = SIN(H) * COS(DEC) / (-BA + AB * COS(H))
670 AZ = ATN(Q) / DRC
680 IF I = 12 AND (PH - DEC) < 0 THEN AZ = 180
690 IF (I - 12) * AZ < 0 THEN AZ = 180 + AZ
700 IF I < 12 THEN I$ = STR$(I) + " AM": GOTO 720
710 IF I = 12 THEN I$ = " 12 PM" ELSE I$ = STR$(I - 12) + " PM"
720 IF AZ <= 180 THEN AZ = AZ + 180 ELSE AZ = AZ - 180
725 IF I = 0 OR I = 24 THEN AZ = 90 * (1 - LSN)
728 IF VAL(I$) >= 10 THEN SP = 1
730 LOCATE I + TSS - 8, 5 - SP
735 IF I < 24 THEN PRINT I$; TAB(21); CINT(Z); TAB(38); CINT(AZ)
738 GOSUB 2110
740 CIRCLE (516 + 50 * SIN(AZ * DRC), 150 - 50 * COS(AZ * DRC)), 3, 14
742 PAINT (516 + 50 * SIN(AZ * DRC), 150 - 50 * COS(AZ * DRC)), 14
745 GOSUB 2110
750 NEXT I
760 COLOR 12
762 LOCATE 18, 60: PRINT "HIT ANY KEY"
764 LOCATE 19, 56: PRINT "FOR SOLAR INTENSITY": COLOR 15
770 WHILE INKEY$ = "": WEND
780 CLS : GOSUB 3000
790 LOCATE 3, 18: PRINT "SOLAR INTENSITY AND ATMOSPHERIC TRANSPARENCY"
800 LOCATE 6, 3: PRINT "TRANSPARENCY        1"; TAB(43); "0.7"; TAB(63); "0.4"
820 LOCATE 7, 3: PRINT "HOUR"; TAB(20); "INTENSITY"; TAB(40); "INTENSITY"; TAB(60); "INTENSITY"
840 ISR = 121 - 10 * TSS: ISS = 120 + 10 * TSS: REM I SUNRISE, SET
870 FOR I = INT(ISR) TO INT(ISS)
880 H = I * PI / 120 - PI
890 CZ = B + A * COS(H)
895 IF CZ = 1 THEN Z(I) = 0: GOTO 910
900 Z(I) = -ATN(CZ / SQR(-CZ * CZ + 1)) + PI / 2
910 IF CZ <= 0 THEN 1050
920 FOR K = 1 TO 3
930 IRR(I, K) = SC * CZ * (1.3 - .3 * K) ^ (1 / CZ)
940 Q(K) = Q(K) + IRR(I, K)
950 NEXT K
960 Q = SIN(H) * COS(DEC) / (-BA + AB * COS(H))
970 AZ(I) = ATN(Q)
980 IF I = 120 AND (PH - DEC) < 0 THEN AZ(I) = PI
990 IF (I - 120) * AZ(I) < 0 THEN AZ(I) = PI + AZ(I)
1000 IF INT(I / 10) = I / 10 THEN 1020
1010 GOTO 1050
1020 IF I < 120 THEN 1050: REM I$ = STR$(I / 10) + "AM": GOTO 1040
1030 IF I = 120 THEN I$ = "12 PM" ELSE I$ = STR$((I - 120) / 10) + " PM"
1040 IF I > 119 THEN LOCATE I / 10 - 4, 3
1045 PRINT I$; TAB(20); IRR(I, 1); TAB(40); IRR(I, 2); TAB(60); IRR(I, 3)
1050 NEXT I
1060 COLOR 14: LOCATE 9 + TSS, 3
1070 PRINT "DAY'S TOTAL HEAT"; TAB(20); 360 * Q(1); TAB(40); 360 * Q(2); TAB(60); 360 * Q(3)
1075 COLOR 3
1080 LOCATE 22, 25: PRINT "INTENSITIES ARE SYMMETRICAL ABOUT NOON"
1090 LOCATE 23, 19: PRINT "THUS, INTENSITIES AT 3:00 PM AND 9:00 AM ARE EQUAL"
1100 COLOR 12: LOCATE 25, 15: PRINT "TYPE 1  TO SEE 2-D AND 3-D SUNPATHS"
1110 LOCATE 26, 15: PRINT "TYPE 2  TO SEE ONLY 3-D SUNPATH"
1120 LOCATE 27, 6: INPUT "YOUR CHOICE = ", NDIAG
1130 COLOR 15
1190 CLS
1200 IF NDIAG = 2 THEN 1630
1210 WINDOW (-PI - .03, -.75 * PI + .055)-(PI - .03, .75 * PI + .055)
1300 LOCATE 2, 25: PRINT "2-DIMENSIONAL SUNPATH DIAGRAM"
1310 COLOR 11: LOCATE 21, 6: PRINT "BLUE CIRCLES"
1320 LOCATE 22, 6: PRINT "ARE LINES OF"
1330 LOCATE 23, 2: PRINT "CONSTANT ZENITH ANGLE": COLOR 15
1380 FOR J = 1 TO 9
1390 CIRCLE (0, 0), J * PI / 18, 11
1400 NEXT J
1410 LOCATE 16, 62: PRINT "E"
1420 LOCATE 16, 41: PRINT "Z"
1430 LOCATE 16, 20: PRINT "W"
1440 LOCATE 27, 41: PRINT "S"
1450 LOCATE 5, 41: PRINT "N"
1460 LOCATE 13, 21: PRINT "90ø"
1470 LOCATE 13, 28: PRINT "60ø"
1480 LOCATE 13, 37: PRINT "30ø"
1490 LINE (2.4, -.5 - PI / 4)-(2.7, -.49), , B
1497 LOCATE 18, 68: PRINT "SUN HEIGHT"
1498 LOCATE 19, 68: PRINT "90ø"
1499 LOCATE 24, 69: PRINT "0ø"
1500 YI = -Z(ISR) * COS(AZ(ISR))
1510 XI = -Z(ISR) * SIN(AZ(ISR))
1512 LOCATE 7, 10: PRINT "LATITUDE  "; ABS(PH) / DRC; LT$
1514 LOCATE 8, 10: PRINT "DATE     "; MN$; DYN
1516 COLOR 14: LOCATE 7, 62: PRINT "TIME"
1520 FOR I = INT(1 + ISR) TO INT(ISS - 1)
1530 YF = -Z(I) * COS(AZ(I))
1540 XF = -Z(I) * SIN(AZ(I))
1550 LINE (2.45, -.5 - Z(I) / 2)-(2.65, -.5 - Z(I) / 2)
1560 LINE (XI, YI)-(XF, YF)
1570 XI = XF: YI = YF
1580 IF I < 120 THEN TM$ = "AM" ELSE TM$ = "PM"
1582 IF I > 131 THEN HR = INT(I / 10) - 12 ELSE HR = INT(I / 10)
1584 MN = 60 * (I / 10 - INT(I / 10))
1588 LOCATE 8, 58: PRINT HR; TAB(62); ":"; TAB(63); MN; TAB(67); TM$
1590 GOSUB 2110
1595 LINE (2.45, -.5 - Z(I) / 2)-(2.65, -.5 - Z(I) / 2), 0
1599 NEXT I
1600 XI = PH - DEC: YI = 0
1610 COLOR 12: LOCATE 28, 29: PRINT "HIT ANY KEY FOR 3-D SUNPATH": COLOR 15
1620 WHILE INKEY$ = "": WEND
1630 CLS : WINDOW (-1.2, -.6)-(1.2, 1.2)
1640 FOR ITH = 1 TO 720
1650 TH1 = ITH * DRC / 2
1660 X = COS(TH1) + CX * SIN(TH1)
1670 Y = CY * SIN(TH1)
1680 PSET (X, Y), 10
1690 NEXT ITH
1700 CIRCLE (0, 0), 1, 11, 0, PI
1710 LINE (-CX, -CY)-(CX, CY), 10
1720 LINE (-1, 0)-(1, 0), 10
1730 GOSUB 2500
1740 LOCATE 23, 40 - 2 * (LSN - .4): PRINT "E"
1750 LOCATE 18, 40 + 2 * (LSN + .4): PRINT "W"
1760 LOCATE 20, 6: PRINT "S"
1770 LOCATE 20, 75: PRINT "N"
1780 LOCATE 5, 2: PRINT "LATITUDE  "; ABS(PH) / DRC; LT$
1790 LOCATE 6, 2: PRINT "DATE     "; MN$; DYN
1792 LINE (-1.1, -.47)-(-.95, -.145), , B
1794 LOCATE 25, 14: PRINT "SUN HEIGHT"
1796 LOCATE 23, 11: PRINT "90"
1798 LOCATE 28, 12: PRINT "0"
1800 LINE (.95, -.455)-(1.1, -.15), , B
1802 LOCATE 25, 60: PRINT "INTENSITY"
1804 LOCATE 23, 68: PRINT "1200"
1806 LOCATE 28, 71: PRINT "0"
1810 DIM ACR(200)
1820 CIRCLE (1.1, 1.1), .02, 12: PAINT (1.1, 1.1), 12
1830 GET (1.08, 1.08)-(1.12, 1.12), ACR
1840 PUT (1.08, 1.08), ACR, XOR
1845 XI = -SIN(Z(ISR)) * COS(AZ(ISR)) + CX * SIN(Z(ISR)) * SIN(AZ(ISR))
1848 YI = COS(Z(ISR)) + CY * SIN(Z(ISR)) * SIN(AZ(ISR))
1850 FOR I = INT(1 + ISR) TO INT(ISS - 1)
1860 LINE (.97, -.45 + IRR(I, 2) / 4000)-(1.08, -.45 + IRR(I, 2) / 4000), 14
1865 LINE (-1.08, -.15 - Z(I) / 5)-(-.97, -.15 - Z(I) / 5), 14
1870 XF = -SIN(Z(I)) * COS(AZ(I)) + CX * SIN(Z(I)) * SIN(AZ(I))
1880 YF = COS(Z(I)) + CY * SIN(Z(I)) * SIN(AZ(I))
1890 IF CLN = 1 THEN LINE (XI, YI)-(XF, YF), 10
1900 IF CLN = 0 THEN PUT (XF - .02, YF - .02), ACR, XOR
1910 IF CLN = 1 THEN PUT (XF - .02, YF - .02), ACR, XOR
1920 IF CLN = 1 THEN PUT (XI - .02, YI - .02), ACR, XOR
1930 IF CLN = 1 THEN LINE (XI, YI)-(XF, YF), 10
1940 CLN = 1
1950 XI = XF: YI = YF
1960 IF I < 120 THEN TM$ = "AM" ELSE TM$ = "PM"
1962 IF I > 131 THEN HR = INT(I / 10) - 12 ELSE HR = INT(I / 10)
1964 MN = 60 * (I / 10 - INT(I / 10))
1970 LOCATE 25, 30: PRINT "TIME = "; TAB(38);
1975 PRINT HR; TAB(42); ":"; TAB(43); MN; TAB(48); TM$
1980 GOSUB 2110
1982 LINE (.97, -.45 + IRR(I, 2) / 4000)-(1.08, -.45 + IRR(I, 2) / 4000), 0
1984 LINE (-1.08, -.15 - Z(I) / 5)-(-.97, -.15 - Z(I) / 5), 0
1990 NEXT I
2000 LOCATE 1, 1: PRINT "TYPE    1    TO SEE SAME SUNPATH AGAIN"
2010 LOCATE 2, 1: PRINT "TYPE    2    FOR ANOTHER LATITUDE AND DATE"
2020 LOCATE 3, 1: PRINT "TYPE    3    TO END PROGRAM"
2030 COLOR 12: LOCATE 2, 50: INPUT "YOUR CHOICE = ", NCH: COLOR 15
2040 ON NCH GOTO 1630, 10, 2100
2100 END
2110 FOR KK = 1 TO 2000
2120 NEXT KK
2130 RETURN
2140 MN$ = "JAN"
2145 GOTO 390
2150 MN$ = "FEB"
2155 GOTO 390
2160 MN$ = "MAR"
2165 GOTO 390
2170 MN$ = "APR"
2175 GOTO 390
2180 MN$ = "MAY"
2185 GOTO 390
2190 MN$ = "JUN"
2195 GOTO 390
2200 MN$ = "JUL"
2205 GOTO 390
2210 MN$ = "AUG"
2215 GOTO 390
2220 MN$ = "SEP"
2225 GOTO 390
2230 MN$ = "OCT"
2235 GOTO 390
2240 MN$ = "NOV"
2245 GOTO 390
2250 MN$ = "DEC"
2255 GOTO 390
2260 GOTO 390
2500 REM SUBROUTINE BLDG
2510 RANDOMIZE VAL(TIME$)
2520 NB = 20
2530 FOR JJ = 1 TO 5
2540 YB = (3 - JJ) / 2.5
2550 YBLD = CY * YB
2560 XMAX = SQR(1 - YB ^ 2)
2580 NBLD = XMAX * NB
2590 FOR NI = 1 TO NBLD
2600 XBLD = XMAX * (2 * RND - 1)
2610 DZBLD = .06 - .03 * YBLD + .05 * RND
2620 DXBLD = .02 - .02 * YBLD + .03 * RND
2630 LINE (XBLD, YBLD)-(XBLD + DXBLD, YBLD + DZBLD), 8, BF
2640 LINE (XBLD, YBLD)-(XBLD + DXBLD, YBLD + DZBLD), 3, B
2650 NEXT NI
2700 NEXT JJ
2800 RETURN
3000 REM SUBROUTINE FRAME
3010 COLOR 15
3020 LINE (0, 0)-(640, 10), 11, BF
3030 LINE (0, 440)-(640, 450), 11, BF
3040 LINE (0, 0)-(10, 450), 11, BF
3050 LINE (630, 0)-(640, 450), 11, BF
RETURN