2009-07-25 17:30

'Just a little routine to calculate the Psychrometric properties
'of air given 3 known conditions.
'
'Given Dry Bulb Temperature, Relative Humidity, and Altitude of a
'location.  The routine calculates 8 other properties of the air
'sample.  Results can be saved.  Mostly useful to HVAC types (Heating
'Ventilation and Air Condicitoning), engineers, science students, etc.
'
'I'd originally written this in another programming language but a
'friend, who is learning to program in RapidQ asked me for an
'an example program in RapidQ that used some simple functions he was
'trying to grasp how to do. ie How to implement math functions, simple
'input boxes, buttons, etc.  And how to save a simple text file.
'
'I'm no real programmer, nor expert by any means with RapidQ, so nothing
'here for any experienced programmer to find useful.
'
'However, I thought perhaps a beginner might find some use in my simple
'style and techniques.  Or perhaps someone will find the math functions
'for deriving the various other properties of air from the given 3 to
'be of use.
'
'Free for anyone to use as he or she sees fit.
'Bob G - Osiyo53@yahoo.com

     $INCLUDE "Rapidq.inc"

     DECLARE SUB calculate_drha
     DECLARE SUB Closemain
     DECLARE SUB Dummyproc
     DECLARE SUB reset_form
     DECLARE SUB save_file

     DIM inout_label_Font AS QFONT
     inout_label_Font.Name   = "MS Sans Serif"
     inout_label_Font.Size   = 8
     inout_label_Font.COLOR  = clWindowText
     inout_label_Font.AddStyles(fsBold,fsUnderLine)
     DIM Label1_Font AS QFONT
     Label1_Font.Name   = "MS Sans Serif"
     Label1_Font.Size   = 8
     Label1_Font.COLOR  = clWindowText
     Label1_Font.AddStyles(fsBold)

     DIM SaveDialog AS QSAVEDIALOG
     SaveDialog.Filter = "Text Files(*.TXT)|*.TXT|All Files(*.*)|*.*"
     SaveDialog.FilterIndex = 1 '' Use "Text Files" as default

     DIM file1 AS QFILESTREAM

     DIM a1 AS DOUBLE
     DIM a2 AS DOUBLE
     DIM a3 AS DOUBLE
     DIM a4 AS DOUBLE
     DIM a5 AS DOUBLE
     DIM a6 AS DOUBLE
     DIM acc AS DOUBLE
     DIM atm AS DOUBLE
     DIM b1 AS DOUBLE
     DIM b2 AS DOUBLE
     DIM b3 AS DOUBLE
     DIM b4 AS DOUBLE
     DIM db AS DOUBLE
     DIM dp AS DOUBLE
     DIM dx AS DOUBLE
     DIM elev AS DOUBLE
     DIM fmid AS DOUBLE
     DIM h AS DOUBLE
     DIM j AS DOUBLE
     DIM nn AS DOUBLE
     DIM p1 AS DOUBLE
     DIM p2 AS DOUBLE
     DIM p3 AS DOUBLE
     DIM p4 AS DOUBLE
     DIM psat AS DOUBLE
     DIM pvp AS DOUBLE
     DIM pvs AS DOUBLE
     DIM rh AS DOUBLE
     DIM rhpercent AS DOUBLE
     DIM rtb AS DOUBLE
     DIM savename AS STRING
     DIM ta AS DOUBLE
     DIM v AS DOUBLE
     DIM vp AS DOUBLE
     DIM w AS DOUBLE
     DIM wb AS DOUBLE
     DIM wh AS DOUBLE
     DIM ws AS DOUBLE
     DIM wsat AS DOUBLE
     DIM wstar AS DOUBLE
     DIM wtemp AS DOUBLE
     DIM xmid AS DOUBLE
     DIM y AS DOUBLE
     DIM z AS DOUBLE


'---------------------------------------------------
' Calculate the Logarithm of a number to the base 10
'
     FUNCTION log10(number AS DOUBLE)AS DOUBLE
      log10 = LOG(number) / LOG(10#)
     END FUNCTION

'---------------------------------------------------
' Calculate Atmospheric pressure given elevation
'
     FUNCTION psychro_atm(elev AS DOUBLE)AS DOUBLE
      DIM el(21)AS DOUBLE, press(21)AS DOUBLE
    'Altitude    Press.
      el(1) = -1000:  press(1) = 31.02
      el(2) = -500:   press(2) = 30.47
      el(3) = 0:      press(3) = 29.921
      el(4) = 500:    press(4) = 29.38
      el(5) = 1000:   press(5) = 28.86
      el(6) = 2000:   press(6) = 27.82
      el(7) = 3000:   press(7) = 26.82
      el(8) = 4000:   press(8) = 25.82
      el(9) = 5000:   press(9) = 24.9
      el(10) = 6000:  press(10) = 23.98
      el(11) = 7000:  press(11) = 23.09
      el(12) = 8000:  press(12) = 22.22
      el(13) = 9000:  press(13) = 21.39
      el(14) = 10000: press(14) = 20.48
      el(15) = 15000: press(15) = 16.89
      el(16) = 20000: press(16) = 13.76
      el(17) = 30000: press(17) = 8.9
      el(18) = 40000: press(18) = 5.56
      el(19) = 50000: press(19) = 3.44
      el(20) = 60000: press(20) = 2.14
      i = 1
      WHILE elev > el(i)
       i = i + 1
      WEND
      psychro_atm = press(i)
     END FUNCTION

'-------------------------------------------------------------------------------
' Calculate vapor pressure at saturation given dry bulb temp
'
     FUNCTION psychro_pvs(temp AS DOUBLE)AS DOUBLE
      a1 = -7.90298
      a2 = 5.02808
      a3 = -0.00000013816
      a4 = 11.344
      a5 = 0.0081328
      a6 = -3.49149
      b1 = -9.09718
      b2 = -3.56654
      b3 = 0.876793
      b4 = 0.0060273
      ta = (temp + 459.688) / 1.8
      IF ta > 273.16 THEN
       z = 373.16 / ta
       p1 = (z - 1) * a1
       p2 = log10(z) * a2
       p3 = ((10 ^ ((1 - (1 / z)) * a4)) - 1) * a3
       p4 = ((10 ^ (a6 * (z - 1))) - 1) * a5
      ELSE
       z = 273.16 / ta
       p1 = b1 * (z - 1)
       p2 = b2 * log10(z)
       p3 = b3 * (1 - (1 / z))
       p4 = log10(b4)
      END IF
      psychro_pvs = 29.921 * (10 ^ (p1 + p2 + p3 + p4))
     END FUNCTION

'-------------------------------------------------------------------------------
' Calculate Humidity Ratio given dry bulb temp, relative humidity, and elevation
'
     FUNCTION psychro_wrh(db AS DOUBLE, rh AS DOUBLE, atm AS DOUBLE)AS DOUBLE
      wsat = psychro_pvs(db)
      wtemp = 0.62198 * (wsat / (atm - wsat))
      psychro_wrh = rh * wtemp
     END FUNCTION

'-------------------------------------------------------------------------------
'Calculate Enthalpy given dry bulb temp and Humidity Ratio
'
     FUNCTION psychro_h_w(db AS DOUBLE, w AS DOUBLE)AS DOUBLE
      psychro_h_w = (db * 0.24) + (1061 + (0.444 * db))* w
     END FUNCTION

'-------------------------------------------------------------------------------
'Calculate dew point temp. given Vapor Pressure
'
     FUNCTION psychro_dp(pvp AS DOUBLE) AS DOUBLE
      nn=pvp*0.491154
      y = LOG(nn)
      IF pvp < 0.18036 THEN
       psychro_dp = 90.12 + (26.142 * y) + (0.8927 * y * y)
      ELSE
       psychro_dp = 100.45 + (33.193 * y) + (2.319 * y * y) + 0.17074*(y^3)+1.2063*((pvp*0.491154)^0.1984)
      END IF
     END FUNCTION

'-------------------------------------------------------------------------------
'Calculate Humidity Ratio given dry bulb temp and pressure
'
     FUNCTION psychro_w_pvp(pair AS DOUBLE, pvp AS DOUBLE) AS DOUBLE
      psychro_w_pvp = 0.622 * pvp / pair
     END FUNCTION

'-------------------------------------------------------------------------------
' Calculate Vapor Pressure given dry bulb temp, wet bulb temp, and pressure
'
     FUNCTION psychro_pv1(db AS DOUBLE, wb AS DOUBLE, atm AS DOUBLE) AS DOUBLE
      pvp =  psychro_pvs(wb)
      ws = (pvp / (atm - pvp)) * 0.62198
      IF wb <= 32 THEN
       wh=((1219.98+0.44*db-0.49*wb)*ws-0.24*(db-wb))/(1219.98+0.44*db-0.49*wb)
       psychro_pv1 = atm * (wh / (0.62198 + wh))
      ELSE
       wh=((1093-0.556*wb)*ws-0.24*(db-wb))/(1093+0.444*db-wb)
       psychro_pv1 = atm * (wh / (0.62198 + wh))
      END IF
     END FUNCTION

'-------------------------------------------------------------------------------
'Calculate Humidity Ratio given dry bulb temp, wet bulb temp, and pressure
'
     FUNCTION psychro_w(db AS DOUBLE, wb AS DOUBLE, atm AS DOUBLE) AS DOUBLE
      vp = psychro_pv1(db, wb, atm)
      psychro_w = 0.622 * vp / (atm - vp)
     END FUNCTION

'-------------------------------------------------------------------------------
'Computes wet-bulb temperature iteratively, dry bulb, dew point
'enthalpy and atm pressure using Bisection method.
'
     FUNCTION wet_bulb(db AS DOUBLE,dp AS DOUBLE,h AS DOUBLE,atm AS DOUBLE)AS DOUBLE
      j=0
      acc=0.0001

      rtb=dp
      dx=db-dp
      WHILE j<40
       j=j+1
       dx=dx*0.5
       xmid=rtb+dx
       psat=psychro_pvs(xmid)
       wstar=psychro_w_pvp(atm-psat, psat)
       fmid=psychro_h_w(xmid, wstar)
       IF ((h-fmid)>0.0)THEN
       rtb=xmid
      END IF
      IF ABS(dx)<acc THEN
       EXIT WHILE
      END IF
     WEND
     wet_bulb=rtb
     wb=rtb
     END FUNCTION

'-------------------------------------------------------------------------------
'Calculate Specific Volume given dry bulb temp, wet bulb temp, and pressure
'
     FUNCTION psychro_v(db AS DOUBLE, wb AS DOUBLE, atm AS DOUBLE)AS DOUBLE
      psychro_v = ((0.754 * (db + 459.7)* (1 + (7000 * psychro_w(db, wb, atm) / 4360))) / atm)
     END FUNCTION

     CREATE MainForm AS QFORM
      CAPTION = "Bob G's (Osiyo) Free Software"
      Top     = 129
      Left    = 203
      Width   = 460
      Height  = 343
      Center
      Wndproc=Dummyproc
      Onclose=Closemain
     END CREATE
     CREATE main_label AS QLABEL
      PARENT  = MainForm
      Top     = 3
      Left    = 93
      Width   = 32
      Height  = 13
      CAPTION = "Calculate Psychrometric Properties of Air"
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE db_label AS QLABEL
      PARENT  = MainForm
      Top     = 51
      Left    = 22
      Width   = 32
      Height  = 13
      CAPTION = "Dry Bulb Temp (F) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE rh_label AS QLABEL
      PARENT  = MainForm
      Top     = 75
      Left    = 5
      Width   = 109
      Height  = 13
      CAPTION = "Relative Humidity (%) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE elev_label AS QLABEL
      PARENT  = MainForm
      Top     = 98
      Left    = 7
      Width   = 32
      Height  = 13
      CAPTION = "Elev Above Sea (FT) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE input_label AS QLABEL
      PARENT  = MainForm
      Top     = 30
      Left    = 51
      Width   = 32
      Height  = 13
      CAPTION = "INPUTS"
      COLOR   = &hC0C0C0
      Font = inout_label_Font
      AutoSize = False
     END CREATE
     CREATE calc_btn AS QBUTTON
      PARENT  = MainForm
      Top     = 72
      Left    = 238
      Width   = 75
      Height  = 25
      CAPTION = "CALCULATE"
      OnClick = calculate_drha
     END CREATE
     CREATE reset_btn AS QBUTTON
      PARENT  = MainForm
      Top     = 72
      Left    = 358
      Width   = 75
      Height  = 25
      CAPTION = "RESET"
      OnClick = reset_form
     END CREATE
     CREATE db_edit AS QEDIT
      PARENT  = MainForm
      Top     = 48
      Left    = 136
      Width   = 49
      Height  = 21
      Text    = "70.0"
      COLOR   = &hFFFFFF
      MaxLength = 5
      AutoSize = False
     END CREATE
     CREATE rh_edit AS QEDIT
      PARENT  = MainForm
      Top     = 72
      Left    = 136
      Width   = 49
      Height  = 21
      Text    = "50.0"
      COLOR   = &hFFFFFF
      MaxLength = 5
     END CREATE
     CREATE elev_edit AS QEDIT
      PARENT  = MainForm
      Top     = 96
      Left    = 135
      Width   = 49
      Height  = 21
      Text    = "1000"
      COLOR   = &hFFFFFF
      MaxLength = 6
     END CREATE
     CREATE output_label AS QLABEL
      PARENT  = MainForm
      Top     = 129
      Left    = 182
      Width   = 32
      Height  = 13
      CAPTION = "OUTPUTS"
      COLOR   = &hC0C0C0
      Font = inout_label_Font
      AutoSize = False
     END CREATE
     CREATE atm_label AS QLABEL
      PARENT  = MainForm
      Top     = 154
      Left    = 18
      Width   = 32
      Height  = 13
      CAPTION = "Atmospheric Press (in.Hg) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE svp_label AS QLABEL
      PARENT  = MainForm
      Top     = 179
      Left    = 6
      Width   = 32
      Height  = 13
      CAPTION = "Saturated Vap Press (in.Hg) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE pvp_label AS QLABEL
      PARENT  = MainForm
      Top     = 202
      Left    = 25
      Width   = 32
      Height  = 13
      CAPTION = "Partial Vap Press (in.Hg) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE hr_label AS QLABEL
      PARENT  = MainForm
      Top     = 226
      Left    = 44
      Width   = 32
      Height  = 13
      CAPTION = "Humidity Ratio (lb/lb) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE atm_edit AS QEDIT
      PARENT  = MainForm
      Top     = 150
      Left    = 179
      Width   = 49
      Height  = 21
      Text    = "0.0"
      COLOR   = &hFFFFFF
      MaxLength = 7
      AutoSize = False
      ReadOnly = True
     END CREATE
     CREATE svp_edit AS QEDIT
      PARENT  = MainForm
      Top     = 174
      Left    = 179
      Width   = 49
      Height  = 21
      Text    = "0.0"
      COLOR   = &hFFFFFF
      MaxLength = 7
      ReadOnly = True
      AutoSize = False
     END CREATE
     CREATE pvp_edit AS QEDIT
      PARENT  = MainForm
      Top     = 199
      Left    = 179
      Width   = 49
      Height  = 21
      Text    = "0.0"
      COLOR   = &hFFFFFF
      MaxLength = 7
      ReadOnly = True
      AutoSize = False
     END CREATE
     CREATE hr_edit AS QEDIT
      PARENT  = MainForm
      Top     = 223
      Left    = 178
      Width   = 49
      Height  = 21
      Text    = "0.0"
      COLOR   = &hFFFFFF
      MaxLength = 7
      AutoSize = False
      ReadOnly = True
     END CREATE
     CREATE svol_label AS QLABEL
      PARENT  = MainForm
      Top     = 154
      Left    = 250
      Width   = 32
      Height  = 13
      CAPTION = "Specific Vol (cuft/lb) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE dp_label AS QLABEL
      PARENT  = MainForm
      Top     = 179
      Left    = 291
      Width   = 32
      Height  = 13
      CAPTION = "Dew Point (F) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE wb_label AS QLABEL
      PARENT  = MainForm
      Top     = 202
      Left    = 297
      Width   = 32
      Height  = 13
      CAPTION = "Wet Bulb (F) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
      AutoSize = False
     END CREATE
     CREATE ent_label AS QLABEL
      PARENT  = MainForm
      Top     = 227
      Left    = 266
      Width   = 32
      Height  = 13
      CAPTION = "Enthalpy (BTU/lb) : "
      COLOR   = &hC0C0C0
      Font = Label1_Font
     END CREATE
     CREATE svol_edit AS QEDIT
      PARENT  = MainForm
      Top     = 150
      Left    = 383
      Width   = 49
      Height  = 21
      Text    = "0.0"
      COLOR   = &hFFFFFF
      MaxLength = 7
      AutoSize = False
      ReadOnly = True
     END CREATE
     CREATE dp_edit AS QEDIT
      PARENT  = MainForm
      Top     = 175
      Left    = 382
      Width   = 49
      Height  = 21
      Text    = "0.0"
      COLOR   = &hFFFFFF
      MaxLength = 7
      AutoSize = False
      ReadOnly = True
     END CREATE
     CREATE wb_edit AS QEDIT
      PARENT  = MainForm
      Top     = 200
      Left    = 382
      Width   = 49
      Height  = 21
      Text    = "0.0"
      COLOR   = &hFFFFFF
      MaxLength = 7
      AutoSize = False
      ReadOnly = True
     END CREATE
     CREATE ent_edit AS QEDIT
      PARENT  = MainForm
      Top     = 225
      Left    = 381
      Width   = 49
      Height  = 21
      Text    = "0.0"
      COLOR   = &hFFFFFF
      MaxLength = 7
      AutoSize = False
      ReadOnly = True
     END CREATE
     CREATE file_btn AS QBUTTON
      PARENT  = MainForm
      Top     = 264
      Left    = 176
      Width   = 75
      Height  = 25
      CAPTION = "Save to File"
      OnClick = save_file
     END CREATE
     MainForm.SHOWMODAL

'-------------------------------------------------------------------------------
'Compute other properties given Dry Bulb Temp.,Relative Humidity and Altitude.
'
     SUB calculate_drha
      db=VAL(db_edit.Text)
      elev=VAL(elev_edit.Text)
      rhpercent=VAL(rh_edit.Text)
      rh=rhpercent/100

'calc atmospheric pressure
      atm=psychro_atm(elev)
      atm_edit.Text = LEFT$((STR$(atm)),7)

'calc vapor pressure at saturation
      pvs=psychro_pvs(db)
      svp_edit.Text = LEFT$((STR$(pvs)),7)

'Calculate Partial Vapor Pressure.
      pvp=pvs*rh
      pvp_edit.TEXT = LEFT$((STR$(pvp)),7)

'calc humidity ratio
      w=psychro_wrh(db, rh, atm)
      hr_edit.Text = LEFT$((STR$(w)),7)

'calculate Enthalpy
      h=psychro_h_w(db, w)
      ent_edit.TEXT = LEFT$((STR$(h)),7)

'calculate Dew Point.
      dp=psychro_dp(pvp)
      dp_edit.Text = LEFT$((STR$(dp)),7)

'Calculate wet bulb temperature using an iterative method.
      IF rh <1.000 THEN
       wb=wet_bulb(db,dp,h,atm)
      ELSE
       wb=db
      END IF
      wb_edit.Text = LEFT$((STR$(wb)),7)

'calculate Specific Volume
      v=psychro_v(db, wb, atm)
      svol_edit.Text = LEFT$((STR$(v)),7)
     END SUB

     SUB Dummyproc   ' To Minimize Properly
     END SUB

     SUB Closemain
      Application.Terminate
     END SUB

     SUB reset_form
      db_edit.Text = "70.0"
      elev_edit.Text = "1000"
      rh_edit.Text = "50.0"
      atm_edit.Text = "0.0"
      svp_edit.Text = "0.0"
      pvp_edit.TEXT = "0.0"
      hr_edit.Text = "0.0"
      ent_edit.TEXT = "0.0"
      dp_edit.Text = "0.0"
      wb_edit.Text = "0.0"
      svol_edit.Text = "0.0"
     END SUB

     SUB save_file
      IF SaveDialog.EXECUTE THEN
       savename = SaveDialog.FileName
       IF UCASE$(RIGHT$(savename,4))<>".TXT" THEN
        savename = savename + ".TXT"
       END IF
       sl1$ = "Dry Bulb Temp (F) : " + db_edit.Text
       sl2$ = "Relative Humidity (%) : " + rh_edit.Text
       sl3$ = "Elev Above Sea (FT) : " + elev_edit.Text
       sl4$ = "Atmospheric Press (in.Hg) : " + atm_edit.Text
       sl5$ = "Saturated Vap Press (in.Hg) : " + svp_edit.Text
       sl6$ = "Partial Vap Press (in.Hg) : " + pvp_edit.TEXT
       sl7$ = "Humidity Ratio (lb/lb) : " + hr_edit.Text
       sl8$ = "Specific Vol (cuft/lb) : " + svol_edit.Text
       sl9$ = "Dew Point (F) : " + dp_edit.Text
       sl10$ = "Wet Bulb (F) : " + wb_edit.Text
       sl11$ = "Enthalpy (BTU/lb) : " + ent_edit.TEXT
       file1.OPEN(savename,fmCreate) ' create a new file
       file1.WriteLine("Inputs Used ..............................")
       file1.WriteLine("")
       file1.WriteLine(sl1$)
       file1.WriteLine(sl2$)
       file1.WriteLine(sl3$)
       file1.WriteLine("")
       file1.WriteLine("")
       file1.WriteLine("Calculated Results .......................")
       file1.WriteLine("")
       file1.WriteLine(sl4$)
       file1.WriteLine(sl5$)
       file1.WriteLine(sl6$)
       file1.WriteLine(sl7$)
       file1.WriteLine(sl8$)
       file1.WriteLine(sl9$)
       file1.WriteLine(sl10$)
       file1.WriteLine(sl11$)
       file1.WriteLine("")
       file1.CLOSE
      END IF
     END SUB

'End Program

2009-07-25 17:30