?? 流量-流速換算.frm
字號:
For i = 1 To 19
y(i) = Val(Text1(i).Text) / 100
Next i
End If
'=========='''''''''==========''''''''==========''''''''=========='''''''''=========='''''''''重新定位用戶所要的項目，除去冗余的對話框
For i = 1 To 19
If Check1(i) Then
kj = kj + 1
If kj <= 9 Then
Check1(i).Top = 375 + 478 * (kj - 1)
Text1(i).Top = 375 + 478 * (kj - 1)
Check1(i).Left = 480
Text1(i).Left = 1200
ElseIf kj > 9 And kj <= 18 Then
Check1(i).Top = 375 + 478 * (kj - 10)
Text1(i).Top = 375 + 478 * (kj - 10)
Check1(i).Left = 2400
Text1(i).Left = 3240
ElseIf kj > 18 And kj <= 19 Then
Check1(i).Top = 375 + 478 * (kj - 19)
Text1(i).Top = 375 + 478 * (kj - 19)
Check1(i).Left = 4320
Text1(i).Left = 5040
End If
Else
Check1(i).Visible = False
Text1(i) = 0#
Text1(i).Visible = False
End If
Next i
'=================='''''''''================''''''''================='''讀入數據'''''=================='''''''''''=================='''''''''================''''''''=================''''''''=================='''''''''=================='''''''''================''''''''=================''''''''=================='''''''''=================='''''''''================
Dim molwt() As String: ReDim molwt(1 To 19): Dim i_m As Long
Dim mm() As Double: ReDim mm(1 To 19) As Double
Open App.Path & "\" & "分子量.txt" For Input As #1 ' 打開文件
Do While Not EOF(1) ' 循環至文件尾
Line Input #1, molwt(i_m + 1)
i_m = i_m + 1
Loop
Close #1 ' 關閉文件
For i = 1 To 19
mm(i) = Val(molwt(i)) * 1
Next i
Dim tempc() As String: ReDim tempc(1 To 19): Dim i_T As Long
Dim ttc() As Double: ReDim ttc(1 To 19) As Double
Open App.Path & "\" & "臨界溫度K.txt" For Input As #2 ' 打開文件
Do While Not EOF(2) ' 循環至文件尾
Line Input #2, tempc(i_T + 1)
i_T = i_T + 1
Loop
Close #2 ' 關閉文件
For i = 1 To 19
ttc(i) = Val(tempc(i)) * 1
Next i
Dim prec() As String: ReDim prec(1 To 19): Dim i_p As Long
Dim ppc() As String: ReDim ppc(1 To 19)
Open App.Path & "\" & "臨界壓力.txt" For Input As #3 ' 打開文件
Do While Not EOF(3) ' 循環至文件尾
Line Input #3, prec(i_p + 1)
i_p = i_p + 1
Loop
Close #3 ' 關閉文件
For i = 1 To 19
ppc(i) = Val(prec(i)) * 1
Next i
Dim Roc() As String: ReDim Roc(1 To 19): Dim i_rou As Long
Dim Rou_c() As Double: ReDim Rou_c(1 To 19) As Double
Open App.Path & "\" & "臨界密度.txt" For Input As #4 ' 打開文件
Do While Not EOF(4) ' 循環至文件尾
Line Input #4, Roc(i_rou + 1)
i_rou = i_rou + 1
Loop
Close #4 ' 關閉文件
For i = 1 To 19
Rou_c(i) = Val(Roc(i)) * 1
Next i
Dim Omegw() As String: ReDim Omegw(1 To 19): Dim i_Ow As Long
Dim Omega_w() As Double: ReDim Omega_w(1 To 19) As Double
Open App.Path & "\" & "偏心因子.txt" For Input As #5 ' 打開文件
Do While Not EOF(5) ' 循環至文件尾
Line Input #5, Omegw(i_Ow + 1)
i_Ow = i_Ow + 1
Loop
Close #5 ' 關閉文件
For i = 1 To 19
Omega_w(i) = Val(Omegw(i)) * 1
Next i
'=================='''''''''================''''''''=================''''''''=================='''''''''''=================='''''''''================''''''''=================''''''''=================='''''''''=================='''''''''================''''''''=================''''''''=================='''''''''=================='''''''''================
For j = 1 To 19 ''''''求分子量
If Check1(j) Then M = y(j) * mm(j) + M
Next j
'=================='''''''''================''''''''=================
If P = 0 Or T = 0 Or Qs = 0 And Qb = 0 Then
MsgBox ("請選擇溫度和壓力的單位")
Combo3.SetFocus
Exit Sub
End If
'=================='''''''''================''''''''=================''''''''=================='''''''''常量列表''=================='''''''''================''''''''=================''''''''=================='''''''''=================='''''''''================''''''''=================''''''''=================='''''''''=================='''''''''================
Dim K() As Double: ReDim K(1 To 19, 1 To 19)
'甲烷
K(1, 1) = 0#: K(1, 2) = 0.01: K(1, 3) = 0.01: K(1, 4) = 0.021: K(1, 5) = 0.023: K(1, 6) = 0.0275: K(1, 7) = 0.031: K(1, 8) = 0.036: K(1, 9) = 0.041: K(1, 10) = 0.05: K(1, 11) = 0.06: K(1, 12) = 0.07: K(1, 13) = 0.081: K(1, 14) = 0.092: K(1, 15) = 0.101: K(1, 16) = 0.025: K(1, 17) = 0.05: K(1, 18) = 0.05
'乙烯
K(2, 2) = 0#: K(2, 3) = 0#: K(2, 4) = 0.003: K(2, 5) = 0.0031: K(2, 6) = 0.004: K(2, 7) = 0.0045: K(2, 8) = 0.005: K(2, 9) = 0.006: K(2, 10) = 0.007: K(2, 11) = 0.0085: K(2, 12) = 0.01: K(2, 13) = 0.012: K(2, 14) = 0.013: K(2, 15) = 0.015: K(2, 16) = 0.07: K(2, 17) = 0.048: K(2, 18) = 0.045
'乙烷
K(3, 3) = 0#: K(3, 4) = 0.003: K(3, 5) = 0.0031: K(3, 6) = 0.004: K(3, 7) = 0.0045: K(3, 8) = 0.005: K(3, 9) = 0.006: K(3, 10) = 0.007: K(3, 11) = 0.0085: K(3, 12) = 0.01: K(3, 13) = 0.012: K(3, 14) = 0.013: K(3, 15) = 0.015: K(3, 16) = 0.07: K(3, 17) = 0.048: K(3, 18) = 0.045
'丙烯
K(4, 4) = 0#: K(4, 5) = 0#: K(4, 6) = 0.003: K(4, 7) = 0.0035: K(4, 8) = 0.004: K(4, 9) = 0.0045: K(4, 10) = 0.005: K(4, 11) = 0.0065: K(4, 12) = 0.008: K(4, 13) = 0.01: K(4, 14) = 0.011: K(4, 15) = 0.013: K(4, 16) = 0.1: K(4, 17) = 0.045: K(4, 18) = 0.04
'丙烷
K(5, 5) = 0#: K(5, 6) = 0.003: K(5, 7) = 0.0035: K(5, 8) = 0.004: K(5, 9) = 0.0045: K(5, 10) = 0.005: K(5, 11) = 0.0065: K(5, 12) = 0.008: K(5, 13) = 0.01: K(5, 14) = 0.011: K(5, 15) = 0.013: K(5, 16) = 0.1: K(5, 17) = 0.045: K(5, 18) = 0.04
'異丁烷
K(6, 6) = 0#: K(6, 7) = 0#: K(6, 8) = 0.008: K(6, 9) = 0.001: K(6, 10) = 0.0015: K(6, 11) = 0.0018: K(6, 12) = 0.02: K(6, 13) = 0.0025: K(6, 14) = 0.003: K(6, 15) = 0.003: K(6, 16) = 0.11: K(6, 17) = 0.05: K(6, 18) = 0.036
'正丁烷
K(7, 7) = 0#: K(7, 8) = 0.008: K(7, 9) = 0.001: K(7, 10) = 0.0015: K(7, 11) = 0.0018: K(7, 12) = 0.002: K(7, 13) = 0.0025: K(7, 14) = 0.003: K(7, 15) = 0.003: K(7, 16) = 0.12: K(7, 17) = 0.05: K(7, 18) = 0.034
'異戊烷
K(8, 8) = 0#: K(8, 9) = 0#: K(8, 10) = 0#: K(8, 11) = 0#: K(8, 12) = 0#: K(8, 13) = 0#: K(8, 14) = 0#: K(8, 15) = 0#: K(8, 16) = 0.134: K(8, 17) = 0.05: K(8, 18) = 0.028
'正戊烷
K(9, 9) = 0#: K(9, 10) = 0#: K(9, 11) = 0#: K(9, 12) = 0#: K(9, 13) = 0#: K(9, 14) = 0#: K(9, 15) = 0#: K(9, 16) = 0.148: K(9, 17) = 0.05: K(9, 18) = 0.02
'己烷
K(10, 10) = 0#: K(10, 11) = 0#: K(10, 12) = 0#: K(10, 13) = 0#: K(10, 14) = 0#: K(10, 15) = 0#: K(10, 16) = 0.172: K(10, 17) = 0.05: K(10, 18) = 0#
'庚烷
K(11, 11) = 0#: K(11, 12) = 0#: K(11, 13) = 0#: K(11, 14) = 0#: K(11, 15) = 0#: K(11, 16) = 0.2: K(11, 17) = 0.05: K(11, 18) = 0#
'辛烷
K(12, 12) = 0#: K(12, 13) = 0#: K(12, 14) = 0#: K(12, 15) = 0#: K(12, 16) = 0.228: K(12, 17) = 0.05: K(12, 18) = 0#
'壬烷
K(13, 13) = 0#: K(13, 14) = 0#: K(13, 15) = 0#: K(13, 16) = 0.264: K(13, 17) = 0.05: K(13, 18) = 0#
'癸烷
K(14, 14) = 0#: K(14, 15) = 0#: K(14, 16) = 0.294: K(14, 17) = 0.05: K(14, 18) = 0#
'十一烷
K(15, 15) = 0#: K(15, 16) = 0.322: K(15, 17) = 0.05: K(15, 18) = 0#
'氮氣
K(16, 16) = 0#: K(16, 17) = 0#: K(16, 18) = 0#
'二氧化碳
K(17, 17) = 0#: K(17, 18) = 0.035
'硫化氫
K(18, 18) = 0#
'=================='''''''''================''''''''=================''''''''=================='''''''''=================='''''''''================''''''''=================''''''''=================='''''''''=================='''''''''================''''''''=================='''''''''================''''''''=================''''''''==================
For i = 1 To 19
For j = 1 To 19
K(j, i) = K(i, j)
'Debug.Print "K(" & i & ","; j & ")=" & K(i, j)
Next j
Next i
For i = 1 To 19
For j = 1 To 19
K(j, i) = K(i, j)
'Debug.Print "K(" & i & ","; j & ")=" & K(i, j)
Next j
Next i
For i = 1 To 19
For j = 1 To 19
K(j, i) = K(i, j)
' Debug.Print Tab((j - 1) * 19 + 1); "K(" & i & ","; j & ")=" & K(i, j); '
Next j
'Debug.Print
Next i
'=================='''''''''================通用常數
A1 = 0.44369: B1 = 0.115449
A2 = 1.28438: B2 = -0.920731
A3 = 0.356306: B3 = 1.70871
A4 = 0.544979: B4 = -0.270896
A5 = 0.528629: B5 = 0.349261
A6 = 0.484011: B6 = 0.75413
A7 = 0.0705233: B7 = -0.044448
A8 = 0.504087: B8 = 1.32245
A9 = 0.0307452: B9 = 0.179433
A10 = 0.0732828: B10 = 0.463492
A11 = 0.00645: B11 = -0.022143
'=================='''''''''================
Dim A_0() As Double: ReDim A_0(1 To 19) As Double
Dim B_0() As Double: ReDim B_0(1 To 19) As Double
Dim C_0() As Double: ReDim C_0(1 To 19) As Double
Dim D_0() As Double: ReDim D_0(1 To 19) As Double
Dim E_0() As Double: ReDim E_0(1 To 19) As Double
Dim a_1() As Double: ReDim a_1(1 To 19) As Double
Dim b_1() As Double: ReDim b_1(1 To 19) As Double
Dim c_1() As Double: ReDim c_1(1 To 19) As Double
Dim d_1() As Double: ReDim d_1(1 To 19) As Double
Dim Alpha_1() As Double: ReDim Alpha_1(1 To 19) As Double
Dim Gamma_1() As Double: ReDim Gamma_1(1 To 19) As Double
'==================================='''''''''''''''''''=================================='''''''''''''''''''==============================
Compute = 0
For i = 1 To 19
If Check1(i) Then
Compute = Compute + 1 '''''''''''''判斷是否為單組分
A_0(i) = (A2 + B2 * Omega_w(i)) * R * ttc(i) / Rou_c(i)
B_0(i) = (A1 + B1 * Omega_w(i)) / Rou_c(i)
C_0(i) = (A3 + B3 * Omega_w(i)) * R * ttc(i) ^ 3 / Rou_c(i)
D_0(i) = (A9 + B9 * Omega_w(i)) * R * ttc(i) ^ 4 / Rou_c(i)
E_0(i) = (A11 + B11 * Omega_w(i) * Exp(-3.8 * Omega_w(i))) * R * ttc(i) ^ 5 / Rou_c(i)
a_1(i) = (A6 + B6 * Omega_w(i)) * R * ttc(i) / (Rou_c(i)) ^ 2
b_1(i) = (A5 + B5 * Omega_w(i)) / (Rou_c(i)) ^ 2
c_1(i) = (A8 + B8 * Omega_w(i)) * R * ttc(i) ^ 3 / (Rou_c(i)) ^ 2
d_1(i) = (A10 + B10 * Omega_w(i)) * R * ttc(i) ^ 2 / (Rou_c(i)) ^ 2
Alpha_1(i) = (A7 + B7 * Omega_w(i)) / (Rou_c(i)) ^ 3
Gamma_1(i) = (A4 + B4 * Omega_w(i)) / (Rou_c(i)) ^ 2
End If
Next i
'''''''''''''''''''''單組分的情況下
For j = 1 To 19
If Compute = 1 And Check1(j) Then
A0_1 = A_0(j): B0_1 = B_0(j): C0_1 = C_0(j): D0_1 = D_0(j): E0_1 = E_0(j)
a0 = a_1(j): b0 = b_1(j): c0 = c_1(j): d0 = d_1(j)
Alpha0 = Alpha_1(j): Gamma0 = Gamma_1(j)
GoTo DAN
End If
Next j
'''''''''''''''''''''' '混合物
For j = 1 To 19
If Check1(j) Then
B0_1 = y(j) * B_0(j) + B0_1
For n = 1 To 19
If Check1(n) Then
A0_1 = y(j) * y(n) * A_0(j) ^ (0.5) * A_0(n) ^ (0.5) * (1 - K(j, n)) + A0_1
C0_1 = y(j) * y(n) * C_0(j) ^ (0.5) * C_0(n) ^ (0.5) * (1 - K(j, n)) ^ 3 + C0_1
D0_1 = y(j) * y(n) * D_0(j) ^ (0.5) * D_0(n) ^ (0.5) * (1 - K(j, n)) ^ 4 + D0_1
E0_1 = y(j) * y(n) * E_0(j) ^ (0.5) * E_0(n) ^ (0.5) * (1 - K(j, n)) ^ 5 + E0_1
End If
Next n
a0_0 = y(j) * (a_1(j)) ^ (1 / 3) + a0_0
b0_0 = y(j) * (b_1(j)) ^ (1 / 3) + b0_0
c0_0 = y(j) * (c_1(j)) ^ (1 / 3) + c0_0
d0_0 = y(j) * (d_1(j)) ^ (1 / 3) + d0_0
Alpha0_0 = y(j) * (Alpha_1(j)) ^ (1 / 3) + Alpha0_0
Gamma0_0 = y(j) * (Gamma_1(j)) ^ (1 / 2) + Gamma0_0
End If
Next j
a0 = a0_0 ^ 3
b0 = b0_0 ^ 3
c0 = c0_0 ^ 3
d0 = d0_0 ^ 3
Alpha0 = (Alpha0_0) ^ 3
Gamma0 = (Gamma0_0) ^ 2
''''''''''''''''''''''''''''''''''''''''''''''''''''''求解密度的方法，來獲得所需要的值，這里用弦截法求密度
DAN: Dim F() As Double: ReDim F(0 To 100000)
Dim Ru() As Double: ReDim Ru(0 To 100000)
Dim PX() As Double: ReDim PX(0 To 100000)
For n = 2 To 10000
Ru(1) = 0: Ru(2) = P / (R * T)
PX(n) = Gamma0 * Ru(n) ^ 2
F(1) = 0
F(n) = Ru(n) * R * T + (B0_1 * R * T - A0_1 - C0_1 / T ^ 2 + D0_1 / T ^ 3 - E0_1 / T ^ 4) * Ru(n) ^ 2 _
+ (b0 * R * T - a0 - d0 / T) * Ru(n) ^ 3 + Alpha0 * (a0 + d0 / T) * Ru(n) ^ 6 _
+ c0 * Ru(n) ^ 3 / T ^ 2 * (1 + PX(n)) * Exp(-PX(n)) - P
Ru(n + 1) = (Ru(n - 1) * F(n) - Ru(n) * F(n - 1)) / (F(n) - F(n - 1))
If Ru(n) > 0 And Ru(n + 1) > 0 And Abs(Ru(n + 1) - Ru(n)) <= 10 ^ (-6) Then
Rho = Ru(n + 1)
Exit For
End If
Next n
'大氣壓 = 0.101325 * 10 ^ 3: 溫度 = 20 + 273.15
Dim Fn() As Double: ReDim Fn(0 To 100000) ''''''''''''''''''算標態下的密度
Dim Ruo() As Double: ReDim Ruo(0 To 100000)
Dim PXo() As Double: ReDim PXo(0 To 100000)
For n = 2 To 10000
Ruo(1) = 0: Ruo(2) = 0.101325 * 10 ^ 3 / (R * 293.15) ''''''''''''''''
PXo(n) = Gamma0 * Ruo(n) ^ 2
Fn(1) = 0
Fn(n) = Ruo(n) * R * 293.15 + (B0_1 * R * 293.15 - A0_1 - C0_1 / 293.15 ^ 2 + D0_1 / 293.15 ^ 3 - E0_1 / 293.15 ^ 4) * Ruo(n) ^ 2 _
+ (b0 * R * 293.15 - a0 - d0 / 293.15) * Ruo(n) ^ 3 + Alpha0 * (a0 + d0 / 293.15) * Ruo(n) ^ 6 _
+ c0 * Ruo(n) ^ 3 / 293.15 ^ 2 * (1 + PXo(n)) * Exp(-PXo(n)) - 0.101325 * 10 ^ 3 '''''''''''''''
Ruo(n + 1) = (Ruo(n - 1) * Fn(n) - Ruo(n) * Fn(n - 1)) / (Fn(n) - Fn(n - 1))
If Ruo(n) > 0 And Ruo(n + 1) > 0 And Abs(Ruo(n + 1) - Ruo(n)) <= 10 ^ (-6) Then
Rho20 = Ruo(n + 1) ''''''''''''
Exit For
End If
Next n
'''''''''''''''''''''''壓縮因子
Z_BWRS = P / (Rho * R * T)
Z_BWRS20 = 101.325 / (Rho20 * R * 293.15)
''''====='''''''====='''''''=======''''''========''''''======='''=======''''''
D = (Val(Text4) - 2 * Val(Text5)) * 10 ^ (-3)
'---m^3/s''''換算為輸送狀態
If Text2 <> "" And Text3 = "" Then Qs = Z_BWRS / Z_BWRS20 * 101.325 * Qb * T / P / 293.15 '秒
'---m^3/s''''換算為標準狀態
If Text3 <> "" And Text2 = "" Then Qb = P * Qs * Z_BWRS20 * 293.15 / T / Z_BWRS / 101.325 '秒
If Text6 = "" Then Vss = Qs / (Pi / 4 * D ^ 2) '每秒流速
If Text6 <> "" Then
Qs = Val(Text6) * (Pi / 4 * D ^ 2) '---m^3/s''''換算為輸送狀態流量
Qb = Z_BWRS / Z_BWRS20 * 101.325 * Qs * T / P / 293.15 '---m^3/s''''換算為標準狀態
End If
''''====='''''''====='''''''=======''''''========''''''======='''=======''''''
Qbd = Qb * 3600 * 24 / 10 ^ 4: Qba = Qbd * 365 / 10 ^ 4
Qsd = Qs * 3600 * 24 / 10 ^ 4: Qsa = Qsd * 365 / 10 ^ 4: Qsh = Qbd / 3600 * 10 ^ 4 '每小時流量
MSFlexGrid1.FormatString = "<序號|^標態下流量(10^4方/d)|^標態下流量(10^8方/a)|^輸態下流量(10^4方/d)|^輸態下流量(10^8方/a)|^每小時流量(方/h)|^流速(m/s)"
MSFlexGrid1.ColWidth(0) = 550
MSFlexGrid1.ColWidth(1) = 2050
MSFlexGrid1.ColWidth(2) = 2050
MSFlexGrid1.ColWidth(3) = 2050
MSFlexGrid1.ColWidth(4) = 2050
MSFlexGrid1.ColWidth(5) = 2050
MSFlexGrid1.ColWidth(6) = 2050
MSFlexGrid1.TextMatrix(1, 0) = 1
MSFlexGrid1.TextMatrix(1, 1) = Format(Qbd, "## ##0.##0 ##0")
MSFlexGrid1.TextMatrix(1, 2) = Format(Qba, "## ##0.##0 ##0")
MSFlexGrid1.TextMatrix(1, 3) = Format(Qsd, "## ##0.##0 ##0")
MSFlexGrid1.TextMatrix(1, 4) = Format(Qsa, "## ##0.##0 ##0")
MSFlexGrid1.TextMatrix(1, 5) = Format(Qsh, "## ##0.##0 ##0")
MSFlexGrid1.TextMatrix(1, 6) = Format(Vss, "## ##0.##0 ##0")
End Sub
Private Sub Command2_Click()
End
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -