QBasic app - BB power spectrum

[KP_PC]

DECLARE SUB PauseQ ()
DECLARE SUB BB00.03 ()

COMMON SHARED PI, C, h, e.NL, BoltzK

    SCREEN 12: COLOR 7
    WINDOW (150, 0)-(0, 15)

    PI = 4 * ATN(1)                ' PI= 3.141592653589793...
    C = 2.99792458# * 10 ^ 8      ' speed of light --- m / s
    h = 6.626076 * 10 ^ -34        ' Plank's Constant --- J * s
    e.NL = 2.718281828459045#     ' Natural Log base
    BoltzK = 1.380658 * 10 ^ -23   ' Boltzmann's constant (J/K)

begin: CLS

   BB00.03    'Planck's law; TempK = 500-5000; Writes Data

   GOTO begin

SUB BB00.03
SHARED xscale, x, yscale, Y

CLS

attr% = 8
COLOR attr%
FoundMax% = 0

GOSUB Setup.BB00.03.denominator

numerator = 2 * PI * h * (C ^ 2) 'constant eq. 40.3 Serway [Planck
empirical]

FOR TempK = 1000 TO 10000 STEP 1000
   PSave = 0
   FoundMax% = 0
   WaveLengthSave = 0
   FOR f = 5 TO .1 STEP -.01
      WaveLength = f * 10 ^ -6
      exponent = (h * C) / (WaveLength * BoltzK * TempK)
      denominator = WaveLength ^ 5 * ((e.NL ^ exponent) - 1)
      P = numerator / denominator

      'LOCATE 1, 1
      'PRINT "denominator ="; denominator; " power ="; P
      'PauseQ
      IF denominator < yscale THEN
         PSET (f, denominator), 7
      END IF

      IF P < PSave AND NOT FoundMax% THEN
         LINE (WaveLengthSave, 0)-(WaveLengthSave, yscale), 8
         FoundMax% = -1
      END IF
      PSave = P
      WaveLengthSave = WaveLength
   NEXT
NEXT

PauseQ

GOSUB Setup.BB00.03

PSET (0, 0), 0
FOR TempK = 1000 TO 10000 STEP 1000
   attr% = attr% + 1
   IF attr% > 15 THEN attr% = 1
   COLOR attr%
   PSave = 0
   FoundMax% = 0
   WaveLengthSave = 0
   FOR f = 5 TO .1 STEP -.01
      WaveLength = f * 10 ^ -6
      exponent = (h * C) / (WaveLength * BoltzK * TempK)
      denominator = WaveLength ^ 5 * ((e.NL ^ exponent) - 1)
      P = numerator / denominator
      LINE -(WaveLength, P)
      PSave = P
      WaveLengthSave = WaveLength
   NEXT
NEXT

PauseQ
EXIT SUB

Setup.BB00.03:

   xscale = 10 * 10 ^ -6         ' X x Y window scale
   yscale = 10 * 10 ^ 14.14
   x = xscale / 2                ' used in grid
   Y = yscale / 2

   WINDOW (0, 0)-(xscale, yscale)

'''Grid.0

RETURN

Setup.BB00.03.denominator:
   xscale = 5
   yscale = 10 ^ -26   'play with this scale to get a feel for how
the
                       'denominator varies - and the 'curve-fitting'
inherent
                       'in the Planck BB eq.
   WINDOW (0, 0)-(xscale, yscale)

RETURN

END SUB

SUB Grid.0
SHARED xscale, x, yscale, Y

    FOR G = 0 TO xscale STEP xscale / 25   ' ESTABLISH GRID LINES
       LINE (G, 0)-(G, yscale), 8           ' DRAW X GRID
    NEXT

    FOR G = 0 TO yscale STEP yscale / 25   ' ESTABLISH GRID LINES
      LINE (0, G)-(xscale, G), 8            ' DRAW Y GRID
    NEXT

    LINE (xscale / 25 * 14, yscale / 25 * 14)-(xscale / 25 * 14,
yscale / 25 * 15), 3
    LINE (xscale / 25 * 14, yscale / 25 * 14)-(xscale / 25 * 15,
yscale / 25 * 14), 3

    'FOR XX = 0 TO xscale STEP xscale / 100 ' ESTABLISH GRID POINTS
    '   FOR YY = 0 TO yscale STEP yscale / 100
    '       PSET (XX, YY), 8
    '   NEXT
    'NEXT

    LOCATE 15, 45: PRINT xscale / 25
    LOCATE 13, 47: PRINT yscale / 25

'    LINE (0, y)-(xscale, y), 7              ' DRAW X AXIS
'    LINE (x, 0)-(x, yscale)                 ' DRAW Y AXIS

END SUB

SUB PauseQ

    COLOR 12: LOCATE 1, 79: PRINT "e"
114 A$ = INKEY$: IF A$ = "" THEN GOTO 114
    IF A$ = "C" OR A$ = "c" THEN CLS      ' ENTERING "C" CLEARS
SCREEN
    IF A$ = "E" OR A$ = "e" THEN END      ' ENTERING "E" ENDS
EXECUTION
    COLOR 0: LOCATE 1, 79: PRINT "e": COLOR 7

END SUB