
( Forth prog to produce table for T & P values )
( Using ******** FLOATING POINT ********* )
( T in Celcius; P in inches Hg from aneroid barometer )
( K=273+C; standard P=1013.2 mbar; 33.86 x in Hg = mbar )
( factor = 1013.2 / P  x  K / 293 to correct air ionisation chamber)
( reading to 293K and 1013.2mbar)

( N.B.  "[ x.yz FLOAT ] LITERAL" puts x.yz on the stack at run-time)
(       in floating point format - used inside colon definitions)

DECIMAL
1013.2 FLOAT CONSTANT P0
293.0  FLOAT CONSTANT T0
17.0   FLOAT VARIABLE mintemp
25.0   FLOAT VARIABLE maxtemp
29.0   FLOAT VARIABLE minP
31.0   FLOAT VARIABLE maxP
0.5    FLOAT VARIABLE dK        ( 0.5 degree increment)

: in->mbar  [ 33.86 FLOAT ] LITERAL F* ;     ( in--mbar)
: C->K  [ 273 FLOAT ] LITERAL F+ ;  ( C--K)
: K->C  [ 273 FLOAT ] LITERAL F- ;  ( K...C)

0.2 FLOAT in->mbar VARIABLE dP     ( = 0.2 inches to mbar increment)

: corr ( P in mbar, T in K -- factor)
   T0         ( P,K,T0 .. )
   F/         ( P, K/293.. )
   P0 ROT     ( K/293,P0,P .. )
   F/ F* ;

: indent  4 SPACES ;

: title CR
   13 SPACES ." Chamber Correction Factors for Temperature and Pressure" CR CR ;

: header  ( Note use of [ and ] )
   1 FLD !                      ( for # dec places - fp nos)
   indent ." P (in.): "
   minP @                       ( min P )
   BEGIN
    DUP  F. SPACE               ( P)
    [ 0.2 FLOAT ] LITERAL F+    ( P+dP - inches)
    DUP maxP @ [ 0.1 FLOAT ] LITERAL F+ F>
   UNTIL
   DROP
   CR CR indent ." Temp(C)" ;

: footer indent ." Table printed on ..............." ;

: table  ( min temp  ... )
   BEGIN
    minP @ in->mbar      ( min temp in K, lower pressure in mbar for row...)
    CR indent
    SWAP DUP K->C 1 FLD ! F. SWAP 3 SPACES     ( temp in K,P in mbar...) ( printed in C - top left)
    3 FLD !
    BEGIN                ( start a row - increasing pressure for same temp)
     SWAP                ( pressure mbar, temp in K...)
     2DUP                ( P in mbar, T in K ...) ( x2)
     corr F.             ( P in mbar,T in K ...)
     SWAP dP @ F+        ( temp in K,P+dP...)
     DUP maxP @ in->mbar F>=     ( temp in K,P+dP,flag...)
    UNTIL
    DROP dK @ F+             ( T+dK........)
    DUP maxtemp @ C->K F>=   ( new T in K,flag........)
   UNTIL
   DROP ;

: show_corrs  title
  [ 27.0 FLOAT ] LITERAL minP !  [ 29.0 FLOAT ] LITERAL maxP !  mintemp @ C->K
  header  table  CR CR
  [ 29.0 FLOAT ] LITERAL minP !  [ 31.0 FLOAT ] LITERAL maxP !  mintemp @ C->K
  header  table  CR CR
  [ 31.0 FLOAT ] LITERAL minP !  [ 33.0 FLOAT ] LITERAL maxP !  mintemp @ C->K
  header  table  CR CR
  footer ;

show_corrs


