OPTION BASE 1
DEFDBL A-H, J-W: DEFSNG X-Z: DEFINT I
DIM y(77)
y(1) = .00003959#
y(2) = .00006395#
y(3) = .00012
y(4) = .000216
y(5) = .000397
y(6) = .000643
y(7) = .00121
y(8) = .00218
y(9) = .004
y(10) = .0073
y(11) = .0116
y(12) = .0168
y(13) = .023
y(14) = .0298
y(15) = .038
y(16) = .048
y(17) = .06
y(18) = .0739
y(19) = .091
y(20) = .1126
y(21) = .139
y(22) = .1693
y(23) = .208
y(24) = .2586
y(25) = .323
y(26) = .4073
y(27) = .503
y(28) = .6082
y(29) = .71
y(30) = .7932
y(31) = .862
y(32) = .9149
y(33) = .954
y(34) = .9803
y(35) = .995
y(36) = 1.0002
y(37) = .995
y(38) = .9786
y(39) = .952
y(40) = .9154
y(41) = .87
y(42) = .8163
y(43) = .757
y(44) = .6949
y(45) = .631
y(46) = .5668
y(47) = .503
y(48) = .4412
y(49) = .381
y(50) = .321
y(51) = .26499
y(52) = .21699
y(53) = .17499
y(54) = .13823
y(55) = .107
y(56) = .08159
y(57) = .06099
y(58) = .04458
y(59) = .032
y(60) = .0232
y(61) = .01701
y(62) = .01192
y(63) = .008209
y(64) = .005708
y(65) = .004116
y(66) = .002925
y(67) = .002095
y(68) = .00148
y(69) = .001045
y(70) = .00072
y(71) = .0005
y(72) = .00036
y(73) = .00025
y(74) = .000175
y(75) = .00012
y(76) = .000083
y(77) = .00006

10 SCREEN 0: CLS : INPUT "TEMP. K ( 1720 to 31600 )"; t
IF t < 1720 OR t > 31600 THEN 10
CT = .01438 / t
L = 0
FOR I = 1 TO 77
U = .000000375# + .000000005# * I
LUM = 1.27244D-19 / U / U / U / U / U / (EXP(CT / U) - 1)
L = L + y(I) * LUM
NEXT I
pt = .000000056696# * t * t * t * t
CT = .01438384# / t
upk = .00289776# / t

zp = 31415.92 * L * .00000031831# / pt:

ppk = 3.73714D-24 / upk / upk / upk / upk / upk / (EXP(CT / upk) - 1)
pprime = 1000 * ppk / zp / pt

p = 0
FOR U = .00000025# TO .00000040002# STEP .000000001#
PY = 3.73714D-25 / U / U / U / U / U / (EXP(CT / U) - 1)
p = p + PY
IF U < .00000025002# THEN p = p - .5 * PY
IF U > .00000039998# THEN p = p - .5 * PY
NEXT U
zz = 1000 * p / pt / zp

SCREEN 12: WIDTH 80, 60
PALETTE 7, 2763306'BRIGHT GRAY LINES
PALETTE 8, 2368548'GRAY LINES
PALETTE 10, 16128'GREEN
PALETTE 15, 3684408'moderately bright white
PALETTE 14, 14399'truly yellow

FOR iy = 0 TO 10
LOCATE 1 + (iy * 5), 1
PRINT USING "#.###"; pprime * .1 * (10 - iy);
NEXT iy

LOCATE 52, 4
PRINT "250   300   350    400   450   500    550   600   650   700   750   800   850";
LOCATE 53, 1
PRINT "                          Wavelength in nanometers"
PRINT
PRINT "        Vertical scale:  mW per lumen per 10 nM bandwidth"
COLOR 14: PRINT "        Total UV 250-400 nM in mW/lumen is "; USING "##.####"; zz
COLOR 15: PRINT : PRINT "      "; t; "Kelvin.   Hit X to end,   any other key to try another temp."


FOR iy = 0 TO 9
iy4 = 40 * iy + 3
LINE (39, iy4)-(639, iy4), 7, , 255
FOR iyy = 1 TO 9
LINE (39, iy4 + 4 * iyy)-(639, iy4 + 4 * iyy), 8, , 21845
NEXT iyy
NEXT iy
LINE (39, 3)-(639, 3), 7
LINE (39, 403)-(639, 403), 7

FOR ix = 39 TO 639 STEP 50
LINE (ix, 3)-(ix, 403), 7
FOR ix4 = 10 TO 40 STEP 10
LINE (ix + ix4, 3)-(ix + ix4, 403), 8, , 21845
NEXT ix4
NEXT ix

U = .00000025#
PY = 3.73714D-24 / U / U / U / U / U / (EXP(CT / U) - 1)
PSET (39, 400 - 400 * (PY / ppk)), 4

ix = 40
FOR U = .000000251# TO .0000008502# STEP .000000001#
PY = 3.73714D-24 / U / U / U / U / U / (EXP(CT / U) - 1)
LINE -(ix, 403 - 400 * (PY / ppk)), 10
ix = ix + 1
NEXT U

20 A$ = INKEY$: IF A$ = "" THEN 20
A$ = UCASE$(A$)
IF (A$) = "X" THEN SCREEN 0: END ELSE 10