热管空气换热器计算程序源代码
晨怡热管
2009-9-16 13:09:20
Option Explicit
Const gc = 1.3 * 10000000#
Const Pi = 3.1415926
Dim Thf, Tcf As Single
' 烟气定性温度，Th1 热侧入口温度，Tc1 冷侧入口，冷侧出口，空气侧定性温度
Dim Chp, Denhf0, Denhf, Landahf, Uhf, Prh As Single
'烟气定压比热容，密度（0 度） ，导热系数，粘度，普朗特数
Dim Ccp, Ccpm, Dencf0, Dencf, landacf, Ucf, Prc As Single
'空气
Dim B1, N1, M1 As String
'设定的每排管数，管总数，总排数
'Dim Qh As Single
'烟气放热量，Qc 冷空气获得热量
Dim Wnh, Wnc As Single
'Vh 热侧体积流量，Vc 冷侧，Wn 标准迎面风速，热侧实际迎面风速
Dim Ahex, Acex, Eh, Ec As Single
'烟气侧迎风面积， ，迎风面宽度
'ST 管子横向间距，SL 纵向,Lh 热侧长度，
Dim Di, Df As Single
'管内径，翅片外径,Ditaf 翅片高度，SF 翅片厚度，翅片间距，翅片节距，
Dim nfh, nfc As Long
'热侧每米翅片数,LnTm 平均对数温差，
Dim NFAh, NFAc, Ghmax, Gcmax, Rehf, Recf, Rehf1, Recf1 As Single
' 管束最小流通面积，热侧最大质量流量， ，热侧雷诺数， ，实际雷诺数
Dim hhf, hcf, landahw, landacw, Nhf, Ncf As Single
'热侧换热系数， ，翅片材料导热系数， ，翅片效率
Dim Afh, Arh, Ahh, Afc, Arc, Ahc, hhfe, hcfe, Rhy, Rhw, Rcw As Single
'热侧每米翅片表面积，翅片间管外表面积，每米总表面积，有效换热系数， ，污垢热阻，
管壁热阻， ，
'Ditaw 管壁厚度，UH 总换热系数，Ahh1 热侧总传热面积
Dim Ahw, Acw, Ahi, Aci, NFV, Dhev, Dcev As Single
'管子中径园管面积，管子内表面积， ，换热器净自由容积，容积当量面积
Dim Fh, Fc, Thw, Tcw, Uhw, Ucw As Single
'热侧摩擦系数， ，平均管壁温度， ，热侧流体粘度， ，Dph, Dpc 热侧压降
Dim Whj, Wcj, Wminj, Wmaxj As Single
'Mh, Mc,热侧质量流量， ，
'Dim Th1j(20), Tc2j(20) As Single
'逐排热侧入口温度， ，
Function FcoolTem(Tcff As Single)
Dim Xy(11) As Single
Datair.Recordset.MoveFirst
Do While Not Datair.Recordset.EOF
Xy(0) = Datair.Recordset.Fields("temair")
Xy(2) = Datair.Recordset.Fields("Cphair")
Xy(4) = Datair.Recordset.Fields("Densityair")
Xy(6) = Datair.Recordset.Fields("Landair")
Xy(8) = Datair.Recordset.Fields("Uair")
Xy(10) = Datair.Recordset.Fields("Prair")
Datair.Recordset.MoveNext
If Tcff < Datair.Recordset.Fields("temair") Then
Xy(1) = Datair.Recordset.Fields("temair")
Xy(3) = Datair.Recordset.Fields("Cphair")
Xy(5) = Datair.Recordset.Fields("Densityair")
Xy(7) = Datair.Recordset.Fields("Landair")
Xy(9) = Datair.Recordset.Fields("Uair")
Xy(11) = Datair.Recordset.Fields("Prair")
Exit Do
End If
Loop
'线性插值
Ccp = Xy(2) + (Xy(3) - Xy(2)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
Dencf = Xy(4) + (Xy(5) - Xy(4)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
landacf = Xy(6) + (Xy(7) - Xy(6)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
landacf = landacf * 0.01
Ucf = Xy(8) + (Xy(9) - Xy(8)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
Ucf = Ucf * 0.000001
Prc = Xy(10) + (Xy(11) - Xy(10)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
End Function
Function FhotTem(Thff As Single)
Dim Xy(11) As Single
Datsoot.Recordset.MoveFirst
Do While Not Datsoot.Recordset.EOF
Xy(0) = Datsoot.Recordset.Fields("temsoot")
Xy(2) = Datsoot.Recordset.Fields("Cphsoot")
Xy(4) = Datsoot.Recordset.Fields("Densitysoot")
Xy(6) = Datsoot.Recordset.Fields("Landasoot")
Xy(8) = Datsoot.Recordset.Fields("Usoot")
Xy(10) = Datsoot.Recordset.Fields("Prsoot")
Datsoot.Recordset.MoveNext
If Thff < Datsoot.Recordset.Fields("temsoot") Then
Xy(1) = Datsoot.Recordset.Fields("temsoot")
Xy(3) = Datsoot.Recordset.Fields("Cphsoot")
Xy(5) = Datsoot.Recordset.Fields("Densitysoot")
Xy(7) = Datsoot.Recordset.Fields("Landasoot")
Xy(9) = Datsoot.Recordset.Fields("Usoot")
Xy(11) = Datsoot.Recordset.Fields("Prsoot")
Exit Do
End If
Loop
'线性插值
Chp = Xy(2) + (Xy(3) - Xy(2)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
Denhf = Xy(4) + (Xy(5) - Xy(4)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
Landahf = Xy(6) + (Xy(7) - Xy(6)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
Landahf = Landahf * 0.01
Uhf = Xy(8) + (Xy(9) - Xy(8)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
Uhf = Uhf * 0.000001
Prh = Xy(10) + (Xy(11) - Xy(10)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
End Function
Private Sub cmdnewinput_Click()
frmain.Show
End Sub
Private Sub weight_Cal()
'计算设备总重量
Dim AfLh, AfLc As Single
Datweight.Recordset.FindFirst ("exdimeter=" & CSng(D0 * 1000#) & _
"and Ditaw= " & CSng(Ditaw * 1000#) & "and Pipe= True")
W1 = Datweight.Recordset.Fields("KGperM")
W1 = W1 * (Lh + Lc + 0.35)
Datweight.Recordset.FindFirst ("Exdimeter=" & CSng(Lf * 1000#) & "and
Ditaw=" & _
CSng(Ditaf * 1000#) & "and pipe= False")
W2 = Datweight.Recordset.Fields("KGperM")
AfLh = 1# / Sfh * (Pi * (D0 + Lf / 2#)) * (Lh + 0.35)
AfLc = 1# / Sfc * (Pi * (D0 + Lf / 2#)) * Lc
W2 = W2 * (AfLh + AfLc)
W3 = W1 + W2 + 5# '含 5KG 附件
W4 = W3 * N
W5 = W4 * 0.4
W6 = W4 * 0.15
W7 = W4 + W5 + W6
'MsgBox ("热管总重 = " & CSng(W4) & " 壳体重量 = " & CSng(W5) & " 喇叭口
重量 = " & _
CSng(W6) & " 热管换热器毛重 = " & CSng(W7))
End Sub
Private Sub Cmdcal_Click()
Tc20 = CSng(Text1.Text)
If (Th1 - Tc20) < 10 Then
MsgBox ("你假设的冷侧出口温度不恰当！")
Exit Sub
End If
'实际需要冷侧出口温度
Wn = Text2.Text
'迎面风速
If MsgBox("是否要确定的热管结构参数（每排管数，排数，总数）？", vbYesNo +
vbQuestion) = vbYes Then
B1 = InputBox("每排管数为：", "要确定的热管结构参数", "33")
M1 = InputBox("热管总排数为：", "要确定的热管结构参数", "12")
N1 = M1 * B1 - CInt(M1 / 2#) 'InputBox("热管总数为：",
"要确定的热管结构参数", "390")
If B1 = "" Or M1 = "" Or N1 = "" Then
MsgBox ("没有指定热管结构参数！")
Exit Sub
Else
structure = True
End If
Else
structure = False
End If
'是否要确定结构参数
If structure = True Then
Thermal_Cal
'热力平衡计算
PipeDesign
'热管换热器结构设计计算
B = CInt(B1)
M = CInt(M1)
N = CInt(N1)
Else
Thermal_Cal
'热力平衡计算
PipeDesign
'热管换热器结构设计计算
End If
divercomputation
'热管换热器模拟计算
weight_Cal
'计算重量
frmresult.Show
'显示结果
End Sub
Sub Thermal_Cal()
Dim Dtmin, Dtmax, Xy0 As Single
Dim XXy, LL As Single
Datsoot.Recordset.MoveFirst
Denhf0 = Datsoot.Recordset.Fields("densitysoot")
Datair.Recordset.MoveFirst
Dencf0 = Datair.Recordset.Fields("densityair")
Tc2 = Tc20
Tcf = (Tc1 + Tc2) / 2#
FcoolTem (Tcf)
'计算传热量
Qc = Vc * Dencf0 * Ccp * (Tc2 - Tc1) / 3600#
Qh = (1 + 0.05) * Qc
Thf = Th1
Do
FhotTem (Thf)
XXy = Chp
Th2 = Th1 - Qh * 3600# / (Vh * Denhf0 * Chp)
Thf = (Th1 + Th2) / 2#
FhotTem (Thf)
If ((XXy - Chp) / XXy) < 0.05 Then
Exit Do
End If
Thf = Thf + 10#
Loop
Dtmax = Abs(Th1 - Tc2)
Dtmin = Abs(Th2 - Tc1)
If Dtmax < Dtmin Then
XXy = Dtmax
Dtmax = Dtmin
Dtmin = XXy
End If
LnTm = (Dtmax - Dtmin) / Log(Dtmax / Dtmin)
End Sub
Sub PipeDesign()
'确定热管换热器结构设计
Dim Dtmin, Dtmax, Xy0 As Single
Dim XXy, LL As Single
'计算每排管子数
' Wn = 2.5
Ahex = Vh / (Wn * 3600#)
Acex = Vc / (Wn * 3600#)
Eh = Ahex / Lh
B = CInt(Eh / ST + 0.5) '取整
Eh = B * ST
Ec = Eh
E = Eh
Wnh = Vh / (Eh * 3600#)
Wnc = Vc / (Ec * 3600#)
Ahex = Eh * Lh
Acex = Ec * Lc
'求总传热系数
'管束最小流通截面积
nfh = 1# / (Sfh + Ditaf)
nfc = 1# / (Sfc + Ditaf)
NFAh = ((ST - D0) - 2# * Lf * Ditaf * nfh) * Lh * B
NFAc = ((ST - D0) - 2# * Lf * Ditaf * nfc) * Lc * B
'流体最大质量流量
Ghmax = Vh * Denhf0 / NFAh
Gcmax = Vc * Dencf0 / NFAc
Rehf = Ghmax * D0 / (Uhf * 3600#)
Recf = Gcmax * D0 / (Ucf * 3600#)
'流体换热系数
hhf = 0.137 * Landahf / D0 * Rehf ^ 0.6338 * Prh ^ 0.3333
hcf = 0.137 * landacf / D0 * Recf ^ 0.6338 * Prc ^ 0.3333
'翅片效率
landahw = 48#
landacw = 57#
Nhf = Lf * (2# * hhf / (Ditaf * landahw)) ^ 0.5
Ncf = Lf * (2# * hcf / (Ditaf * landacw)) ^ 0.5
'可修改 Nhf,Ncf
Nhf = 0.88
Ncf = 0.9
'每米长热管管外总表面积
Df = D0 + 2# * Lf
Afh = (2# * Pi / 4# * (Df ^ 2# - D0 ^ 2#) + Pi * Df * Ditaf) * nfh
Afc = (2# * Pi / 4# * (Df ^ 2# - D0 ^ 2#) + Pi * Df * Ditaf) * nfc
Arh = Pi * D0 * (1 - nfh * Ditaf)
Arc = Pi * D0 * (1 - nfc * Ditaf)
Ahh = Afh + Arh
Ahc = Afc + Arc
'管外有效换热系数
hhfe = hhf * (Arh + Nhf * Afh) / Ahh
hcfe = hcf * (Arc + Ncf * Afc) / Ahc
'污垢热阻及管壁热阻
Rhy = 0.00035
Di = D0 - 2 * Ditaw
Rhw = Ditaw / landahw
Rcw = Ditaw / landacw
'总传热系数
Ahw = Pi * ((D0 + Di) / 2#) * Lh
Acw = Pi * ((D0 + Di) / 2#) * Lc
Ahi = Pi * Di * Lh
Aci = Pi * Di * Lc
UH = 1# / hhfe + Rhw * Ahh / Ahw + Rhy _
+ 1# / 5810# * Ahh / Ahi + 1# / 5810# * Ahc / Aci _
+ Rcw * Ahh / Acw + Ahh / (Ahc * hcfe)
UH = 1# / UH
'加热侧总传热面积
Ahh1 = Qc * 1000# / (UH * LnTm)
'Ahh1 = Qh * 1000# / (UH * LnTm)
'求所需热管数
N = CInt(Ahh1 / (Ahh * (Lh + 0.35)))
'求换热器纵深排数
M = CInt(N / B + 0.5)
N = M * B - CInt(M / 2#)
'求通过换热器的压力降
NFV = 0.866 * SL * ST - Pi / 4# * D0 ^ 2# - _
Pi / 4# * (Df ^ 2# - D0 ^ 2#) * Ditaf * nfh
Dhev = 4# * NFV / Ahh
NFV = 0.866 * SL * ST - Pi / 4# * D0 ^ 2# - _
Pi / 4# * (Df ^ 2# - D0 ^ 2#) * Ditaf * nfc
Dcev = 4# * NFV / Ahc
Rehf1 = Dhev * Ghmax / (Uhf * 3600#)
Recf1 = Dcev * Gcmax / (Ucf * 3600#)
Fh = 1.92 * Rehf1 ^ (-0.145)
Fc = 1.92 * Recf1 ^ (-0.145)
Thw = Thf - Qh * 1000# / (hhfe * Ahh * Lh * N)
Tcw = Tcf + Qc * 1000# / (hcfe * Ahc * Lc * N)
Uhw = 24.5 * 0.000001 '查表
Ucw = 25.65 * 0.000001
L = Sqr(SL ^ 2# - (ST / 2#) ^ 2#) * M
Dph = Fh / 2# * Ghmax ^ 2# * L / (gc * Dhev * Denhf) _
* (Uhf / Uhw) ^ (-0.14) * (Dhev / ST) ^ 0.4 * (SL / ST) ^ 0.6
Dpc = Fc / 2# * Gcmax ^ 2# * L / (gc * Dcev * Dencf) _
* (Ucf / Ucw) ^ (-0.14) * (Dcev / ST) ^ 0.4 * (SL / ST) ^ 0.6
End Sub
' 离散模型
Sub divercomputation()
Dim j As Integer
ReDim Th1j(M + 1#), Tc2j(M + 1#), Twj(M), Qi(M), Qi1Bi(M), Tvj(M)
'逐排热侧入口温度， ，热侧壁温,每排功率,单管功率,管内蒸汽温度
ReDim Bi(M)
'每排管数
ReDim Rhj(M), Rc1j(M), Rhi(M), Rci(M), Rpj(M)
'管外对流换热热阻， ，管径导热热阻，蒸发，凝结热阻
TemRow (Tc20)
Do While Abs(Tc2j(M) - Tc1) > 0.05
If (Tc2j(M) - Tc1) < 0 Then
Tc20 = Tc20 + 0.005
Else
Tc20 = Tc20 - 0.005
End If
TemRow (Tc20)
Loop
'第二步
For j = 1 To M
If (j Mod 2) = 0# Then
Bi(j - 1) = B - 1
Else
Bi(j - 1) = B
End If
'Dim Rhj(), Rc1j(), Rwhj, Rwcj, Rhi(), Rci(), Rpj() As Single
'管外对流换热热阻， ，管径导热热阻，蒸发，凝结热阻
Rhj(j - 1) = 1# / (hhfe * Ahh * Lh * Bi(j - 1))
Rc1j(j - 1) = 1# / (hcfe * Ahc * Lc * Bi(j - 1))
'Rwhj(j) = 1# / (2# * Pi * Landawh * Lh) * Log(D0 / Di)
'Rwcj(j) = 1# / (2# * Pi * Landawc * Lc) * Log(D0 / Di)
Rhi(j - 1) = 1# / (5810# * Ahi * Lh * Bi(j - 1)) 'hhHp=hcHp=5810.0
Rci(j - 1) = 1# / (5810# * Aci * Lc * Bi(j - 1))
Rpj(j - 1) = Rhj(j - 1) + Rc1j(j - 1) + Rwhj + Rwcj + Rhi(j - 1) + Rci(j
- 1)
'热阻
Tvj(j - 1) = ((Rhj(j - 1) + Rwhj + Rhi(j - 1)) / Rpj(j - 1)) * ((Tc2j(j - 1)
+ Tc2j(j)) / 2#) _
+ ((Rc1j(j - 1) + Rwcj + Rci(j - 1)) / Rpj(j - 1)) * ((Th1j(j - 1) + Th1j(j))
/ 2#)
'
'每排功率
Qi(j - 1) = (Th1j(j - 1) - Tvj(j - 1)) / ((Rhj(j - 1) + Rwhj + Rhi(j
- 1)) * 1000#)
'(Whj * (Th1j(j - 1) - Th1j(j))) / 3600#
'单管功率
Qi1Bi(j - 1) = Qi(j - 1) / Bi(j - 1)
'壁温
Twj(j - 1) = (Th1j(j) + Th1j(j - 1)) / 2# - Qi(j - 1) * 1000# / (hhfe *
Ahh * Lh * B)
'携带功率
' (j)
Next j
End Sub
Sub TemRow(Tc21 As Single)
Dim NTU, Rcj, Esmj As Single
Dim j As Integer
'Tc2 = Tc21
Mh = Denhf0 * Vh
Mc = Dencf0 * Vc
FhotTem (Thf)
FcoolTem (Tcf)
Whj = Mh * Chp
Wcj = Mc * Ccp
Wmaxj = Whj
Wminj = Wcj
If Whj < Wcj Then
Wmaxj = Wcj
Wminj = Whj
Else
Wmaxj = Whj
Wminj = Wcj
End If
'NTU = UH * (Ahh * Lh + Ahc * Lc) * B / Wminj
NTU = 0.1117
Rcj = Wminj / Wmaxj
Esmj = (1 - Exp(-NTU * (1 - Rcj))) / (1 - Rcj * Exp(-NTU * (1 - Rcj)))
'赋初值
Tc2j(0) = Tc21
Th1j(0) = Th1
'第一排
If Whj > Wcj Then 'j-1
Tc2j(1) = (Tc2j(0) - Esmj * Th1j(0)) / (1 - Esmj)
Th1j(1) = Th1j(0) - Wcj * (Tc2j(0) - Tc2j(1)) / Whj
Else 'j+1
Tc2j(1) = (Tc2j(0) - Rcj * Esmj * Th1j(0)) / (1# - Rcj * Esmj)
Th1j(1) = Th1j(0) - Esmj * (Th1j(0) - Tc2j(0))
End If
'逐排计算
Rwhj = 1# / (2# * Pi * landahw * Lh) * Log(D0 / Di)
Rwcj = 1# / (2# * Pi * landacw * Lc) * Log(D0 / Di)
For j = 1 To M
If Whj > Wcj Then 'j-1
Esmj = (Tc2j(j - 1) - Tc2j(j)) / (Th1j(j - 1) - Tc2j(j))
Tc2j(j + 1) = (Tc2j(j) - Esmj * Th1j(j)) / (1 - Esmj)
Th1j(j + 1) = Th1j(j) - Wcj * (Tc2j(j) - Tc2j(j + 1)) / Whj
Else
Esmj = (Th1j(j) - Th1j(j + 1)) / (Th1j(j) - Tc2j(j - 1))
Tc2j(j + 1) = (Tc2j(j) - Rcj * Esmj * Th1j(j)) / (1# - Rcj * Esmj)
Th1j(j + 1) = Th1j(j) - Esmj * (Th1j(j) - Tc2j(j - 1))
End If
Next j
'Tc2j(j + 1) = Tc1
End Sub
Private Sub Command3_Click()
With DatRow.Recordset
.FindFirst ("Proname = " & "'" & Proname & "'")
If Not .NoMatch Then
Do While Not .EOF
.Delete
.MoveNext
Loop
End If
End With
Unload frmresult
Unload frmain
Unload Me
End Sub
Const gc = 1.3 * 10000000#
Const Pi = 3.1415926
Dim Thf, Tcf As Single
' 烟气定性温度，Th1 热侧入口温度，Tc1 冷侧入口，冷侧出口，空气侧定性温度
Dim Chp, Denhf0, Denhf, Landahf, Uhf, Prh As Single
'烟气定压比热容，密度（0 度） ，导热系数，粘度，普朗特数
Dim Ccp, Ccpm, Dencf0, Dencf, landacf, Ucf, Prc As Single
'空气
Dim B1, N1, M1 As String
'设定的每排管数，管总数，总排数
'Dim Qh As Single
'烟气放热量，Qc 冷空气获得热量
Dim Wnh, Wnc As Single
'Vh 热侧体积流量，Vc 冷侧，Wn 标准迎面风速，热侧实际迎面风速
Dim Ahex, Acex, Eh, Ec As Single
'烟气侧迎风面积， ，迎风面宽度
'ST 管子横向间距，SL 纵向,Lh 热侧长度，
Dim Di, Df As Single
'管内径，翅片外径,Ditaf 翅片高度，SF 翅片厚度，翅片间距，翅片节距，
Dim nfh, nfc As Long
'热侧每米翅片数,LnTm 平均对数温差，
Dim NFAh, NFAc, Ghmax, Gcmax, Rehf, Recf, Rehf1, Recf1 As Single
' 管束最小流通面积，热侧最大质量流量， ，热侧雷诺数， ，实际雷诺数
Dim hhf, hcf, landahw, landacw, Nhf, Ncf As Single
'热侧换热系数， ，翅片材料导热系数， ，翅片效率
Dim Afh, Arh, Ahh, Afc, Arc, Ahc, hhfe, hcfe, Rhy, Rhw, Rcw As Single
'热侧每米翅片表面积，翅片间管外表面积，每米总表面积，有效换热系数， ，污垢热阻，
管壁热阻， ，
'Ditaw 管壁厚度，UH 总换热系数，Ahh1 热侧总传热面积
Dim Ahw, Acw, Ahi, Aci, NFV, Dhev, Dcev As Single
'管子中径园管面积，管子内表面积， ，换热器净自由容积，容积当量面积
Dim Fh, Fc, Thw, Tcw, Uhw, Ucw As Single
'热侧摩擦系数， ，平均管壁温度， ，热侧流体粘度， ，Dph, Dpc 热侧压降
Dim Whj, Wcj, Wminj, Wmaxj As Single
'Mh, Mc,热侧质量流量， ，
'Dim Th1j(20), Tc2j(20) As Single
'逐排热侧入口温度， ，
Function FcoolTem(Tcff As Single)
Dim Xy(11) As Single
Datair.Recordset.MoveFirst
Do While Not Datair.Recordset.EOF
Xy(0) = Datair.Recordset.Fields("temair")
Xy(2) = Datair.Recordset.Fields("Cphair")
Xy(4) = Datair.Recordset.Fields("Densityair")
Xy(6) = Datair.Recordset.Fields("Landair")
Xy(8) = Datair.Recordset.Fields("Uair")
Xy(10) = Datair.Recordset.Fields("Prair")
Datair.Recordset.MoveNext
If Tcff < Datair.Recordset.Fields("temair") Then
Xy(1) = Datair.Recordset.Fields("temair")
Xy(3) = Datair.Recordset.Fields("Cphair")
Xy(5) = Datair.Recordset.Fields("Densityair")
Xy(7) = Datair.Recordset.Fields("Landair")
Xy(9) = Datair.Recordset.Fields("Uair")
Xy(11) = Datair.Recordset.Fields("Prair")
Exit Do
End If
Loop
'线性插值
Ccp = Xy(2) + (Xy(3) - Xy(2)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
Dencf = Xy(4) + (Xy(5) - Xy(4)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
landacf = Xy(6) + (Xy(7) - Xy(6)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
landacf = landacf * 0.01
Ucf = Xy(8) + (Xy(9) - Xy(8)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
Ucf = Ucf * 0.000001
Prc = Xy(10) + (Xy(11) - Xy(10)) * (Xy(0) - Tcff) / (Xy(0) - Xy(1))
End Function
Function FhotTem(Thff As Single)
Dim Xy(11) As Single
Datsoot.Recordset.MoveFirst
Do While Not Datsoot.Recordset.EOF
Xy(0) = Datsoot.Recordset.Fields("temsoot")
Xy(2) = Datsoot.Recordset.Fields("Cphsoot")
Xy(4) = Datsoot.Recordset.Fields("Densitysoot")
Xy(6) = Datsoot.Recordset.Fields("Landasoot")
Xy(8) = Datsoot.Recordset.Fields("Usoot")
Xy(10) = Datsoot.Recordset.Fields("Prsoot")
Datsoot.Recordset.MoveNext
If Thff < Datsoot.Recordset.Fields("temsoot") Then
Xy(1) = Datsoot.Recordset.Fields("temsoot")
Xy(3) = Datsoot.Recordset.Fields("Cphsoot")
Xy(5) = Datsoot.Recordset.Fields("Densitysoot")
Xy(7) = Datsoot.Recordset.Fields("Landasoot")
Xy(9) = Datsoot.Recordset.Fields("Usoot")
Xy(11) = Datsoot.Recordset.Fields("Prsoot")
Exit Do
End If
Loop
'线性插值
Chp = Xy(2) + (Xy(3) - Xy(2)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
Denhf = Xy(4) + (Xy(5) - Xy(4)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
Landahf = Xy(6) + (Xy(7) - Xy(6)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
Landahf = Landahf * 0.01
Uhf = Xy(8) + (Xy(9) - Xy(8)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
Uhf = Uhf * 0.000001
Prh = Xy(10) + (Xy(11) - Xy(10)) * (Xy(0) - Thff) / (Xy(0) - Xy(1))
End Function
Private Sub cmdnewinput_Click()
frmain.Show
End Sub
Private Sub weight_Cal()
'计算设备总重量
Dim AfLh, AfLc As Single
Datweight.Recordset.FindFirst ("exdimeter=" & CSng(D0 * 1000#) & _
"and Ditaw= " & CSng(Ditaw * 1000#) & "and Pipe= True")
W1 = Datweight.Recordset.Fields("KGperM")
W1 = W1 * (Lh + Lc + 0.35)
Datweight.Recordset.FindFirst ("Exdimeter=" & CSng(Lf * 1000#) & "and
Ditaw=" & _
CSng(Ditaf * 1000#) & "and pipe= False")
W2 = Datweight.Recordset.Fields("KGperM")
AfLh = 1# / Sfh * (Pi * (D0 + Lf / 2#)) * (Lh + 0.35)
AfLc = 1# / Sfc * (Pi * (D0 + Lf / 2#)) * Lc
W2 = W2 * (AfLh + AfLc)
W3 = W1 + W2 + 5# '含 5KG 附件
W4 = W3 * N
W5 = W4 * 0.4
W6 = W4 * 0.15
W7 = W4 + W5 + W6
'MsgBox ("热管总重 = " & CSng(W4) & " 壳体重量 = " & CSng(W5) & " 喇叭口
重量 = " & _
CSng(W6) & " 热管换热器毛重 = " & CSng(W7))
End Sub
Private Sub Cmdcal_Click()
Tc20 = CSng(Text1.Text)
If (Th1 - Tc20) < 10 Then
MsgBox ("你假设的冷侧出口温度不恰当！")
Exit Sub
End If
'实际需要冷侧出口温度
Wn = Text2.Text
'迎面风速
If MsgBox("是否要确定的热管结构参数（每排管数，排数，总数）？", vbYesNo +
vbQuestion) = vbYes Then
B1 = InputBox("每排管数为：", "要确定的热管结构参数", "33")
M1 = InputBox("热管总排数为：", "要确定的热管结构参数", "12")
N1 = M1 * B1 - CInt(M1 / 2#) 'InputBox("热管总数为：",
"要确定的热管结构参数", "390")
If B1 = "" Or M1 = "" Or N1 = "" Then
MsgBox ("没有指定热管结构参数！")
Exit Sub
Else
structure = True
End If
Else
structure = False
End If
'是否要确定结构参数
If structure = True Then
Thermal_Cal
'热力平衡计算
PipeDesign
'热管换热器结构设计计算
B = CInt(B1)
M = CInt(M1)
N = CInt(N1)
Else
Thermal_Cal
'热力平衡计算
PipeDesign
'热管换热器结构设计计算
End If
divercomputation
'热管换热器模拟计算
weight_Cal
'计算重量
frmresult.Show
'显示结果
End Sub
Sub Thermal_Cal()
Dim Dtmin, Dtmax, Xy0 As Single
Dim XXy, LL As Single
Datsoot.Recordset.MoveFirst
Denhf0 = Datsoot.Recordset.Fields("densitysoot")
Datair.Recordset.MoveFirst
Dencf0 = Datair.Recordset.Fields("densityair")
Tc2 = Tc20
Tcf = (Tc1 + Tc2) / 2#
FcoolTem (Tcf)
'计算传热量
Qc = Vc * Dencf0 * Ccp * (Tc2 - Tc1) / 3600#
Qh = (1 + 0.05) * Qc
Thf = Th1
Do
FhotTem (Thf)
XXy = Chp
Th2 = Th1 - Qh * 3600# / (Vh * Denhf0 * Chp)
Thf = (Th1 + Th2) / 2#
FhotTem (Thf)
If ((XXy - Chp) / XXy) < 0.05 Then
Exit Do
End If
Thf = Thf + 10#
Loop
Dtmax = Abs(Th1 - Tc2)
Dtmin = Abs(Th2 - Tc1)
If Dtmax < Dtmin Then
XXy = Dtmax
Dtmax = Dtmin
Dtmin = XXy
End If
LnTm = (Dtmax - Dtmin) / Log(Dtmax / Dtmin)
End Sub
Sub PipeDesign()
'确定热管换热器结构设计
Dim Dtmin, Dtmax, Xy0 As Single
Dim XXy, LL As Single
'计算每排管子数
' Wn = 2.5
Ahex = Vh / (Wn * 3600#)
Acex = Vc / (Wn * 3600#)
Eh = Ahex / Lh
B = CInt(Eh / ST + 0.5) '取整
Eh = B * ST
Ec = Eh
E = Eh
Wnh = Vh / (Eh * 3600#)
Wnc = Vc / (Ec * 3600#)
Ahex = Eh * Lh
Acex = Ec * Lc
'求总传热系数
'管束最小流通截面积
nfh = 1# / (Sfh + Ditaf)
nfc = 1# / (Sfc + Ditaf)
NFAh = ((ST - D0) - 2# * Lf * Ditaf * nfh) * Lh * B
NFAc = ((ST - D0) - 2# * Lf * Ditaf * nfc) * Lc * B
'流体最大质量流量
Ghmax = Vh * Denhf0 / NFAh
Gcmax = Vc * Dencf0 / NFAc
Rehf = Ghmax * D0 / (Uhf * 3600#)
Recf = Gcmax * D0 / (Ucf * 3600#)
'流体换热系数
hhf = 0.137 * Landahf / D0 * Rehf ^ 0.6338 * Prh ^ 0.3333
hcf = 0.137 * landacf / D0 * Recf ^ 0.6338 * Prc ^ 0.3333
'翅片效率
landahw = 48#
landacw = 57#
Nhf = Lf * (2# * hhf / (Ditaf * landahw)) ^ 0.5
Ncf = Lf * (2# * hcf / (Ditaf * landacw)) ^ 0.5
'可修改 Nhf,Ncf
Nhf = 0.88
Ncf = 0.9
'每米长热管管外总表面积
Df = D0 + 2# * Lf
Afh = (2# * Pi / 4# * (Df ^ 2# - D0 ^ 2#) + Pi * Df * Ditaf) * nfh
Afc = (2# * Pi / 4# * (Df ^ 2# - D0 ^ 2#) + Pi * Df * Ditaf) * nfc
Arh = Pi * D0 * (1 - nfh * Ditaf)
Arc = Pi * D0 * (1 - nfc * Ditaf)
Ahh = Afh + Arh
Ahc = Afc + Arc
'管外有效换热系数
hhfe = hhf * (Arh + Nhf * Afh) / Ahh
hcfe = hcf * (Arc + Ncf * Afc) / Ahc
'污垢热阻及管壁热阻
Rhy = 0.00035
Di = D0 - 2 * Ditaw
Rhw = Ditaw / landahw
Rcw = Ditaw / landacw
'总传热系数
Ahw = Pi * ((D0 + Di) / 2#) * Lh
Acw = Pi * ((D0 + Di) / 2#) * Lc
Ahi = Pi * Di * Lh
Aci = Pi * Di * Lc
UH = 1# / hhfe + Rhw * Ahh / Ahw + Rhy _
+ 1# / 5810# * Ahh / Ahi + 1# / 5810# * Ahc / Aci _
+ Rcw * Ahh / Acw + Ahh / (Ahc * hcfe)
UH = 1# / UH
'加热侧总传热面积
Ahh1 = Qc * 1000# / (UH * LnTm)
'Ahh1 = Qh * 1000# / (UH * LnTm)
'求所需热管数
N = CInt(Ahh1 / (Ahh * (Lh + 0.35)))
'求换热器纵深排数
M = CInt(N / B + 0.5)
N = M * B - CInt(M / 2#)
'求通过换热器的压力降
NFV = 0.866 * SL * ST - Pi / 4# * D0 ^ 2# - _
Pi / 4# * (Df ^ 2# - D0 ^ 2#) * Ditaf * nfh
Dhev = 4# * NFV / Ahh
NFV = 0.866 * SL * ST - Pi / 4# * D0 ^ 2# - _
Pi / 4# * (Df ^ 2# - D0 ^ 2#) * Ditaf * nfc
Dcev = 4# * NFV / Ahc
Rehf1 = Dhev * Ghmax / (Uhf * 3600#)
Recf1 = Dcev * Gcmax / (Ucf * 3600#)
Fh = 1.92 * Rehf1 ^ (-0.145)
Fc = 1.92 * Recf1 ^ (-0.145)
Thw = Thf - Qh * 1000# / (hhfe * Ahh * Lh * N)
Tcw = Tcf + Qc * 1000# / (hcfe * Ahc * Lc * N)
Uhw = 24.5 * 0.000001 '查表
Ucw = 25.65 * 0.000001
L = Sqr(SL ^ 2# - (ST / 2#) ^ 2#) * M
Dph = Fh / 2# * Ghmax ^ 2# * L / (gc * Dhev * Denhf) _
* (Uhf / Uhw) ^ (-0.14) * (Dhev / ST) ^ 0.4 * (SL / ST) ^ 0.6
Dpc = Fc / 2# * Gcmax ^ 2# * L / (gc * Dcev * Dencf) _
* (Ucf / Ucw) ^ (-0.14) * (Dcev / ST) ^ 0.4 * (SL / ST) ^ 0.6
End Sub
' 离散模型
Sub divercomputation()
Dim j As Integer
ReDim Th1j(M + 1#), Tc2j(M + 1#), Twj(M), Qi(M), Qi1Bi(M), Tvj(M)
'逐排热侧入口温度， ，热侧壁温,每排功率,单管功率,管内蒸汽温度
ReDim Bi(M)
'每排管数
ReDim Rhj(M), Rc1j(M), Rhi(M), Rci(M), Rpj(M)
'管外对流换热热阻， ，管径导热热阻，蒸发，凝结热阻
TemRow (Tc20)
Do While Abs(Tc2j(M) - Tc1) > 0.05
If (Tc2j(M) - Tc1) < 0 Then
Tc20 = Tc20 + 0.005
Else
Tc20 = Tc20 - 0.005
End If
TemRow (Tc20)
Loop
'第二步
For j = 1 To M
If (j Mod 2) = 0# Then
Bi(j - 1) = B - 1
Else
Bi(j - 1) = B
End If
'Dim Rhj(), Rc1j(), Rwhj, Rwcj, Rhi(), Rci(), Rpj() As Single
'管外对流换热热阻， ，管径导热热阻，蒸发，凝结热阻
Rhj(j - 1) = 1# / (hhfe * Ahh * Lh * Bi(j - 1))
Rc1j(j - 1) = 1# / (hcfe * Ahc * Lc * Bi(j - 1))
'Rwhj(j) = 1# / (2# * Pi * Landawh * Lh) * Log(D0 / Di)
'Rwcj(j) = 1# / (2# * Pi * Landawc * Lc) * Log(D0 / Di)
Rhi(j - 1) = 1# / (5810# * Ahi * Lh * Bi(j - 1)) 'hhHp=hcHp=5810.0
Rci(j - 1) = 1# / (5810# * Aci * Lc * Bi(j - 1))
Rpj(j - 1) = Rhj(j - 1) + Rc1j(j - 1) + Rwhj + Rwcj + Rhi(j - 1) + Rci(j
- 1)
'热阻
Tvj(j - 1) = ((Rhj(j - 1) + Rwhj + Rhi(j - 1)) / Rpj(j - 1)) * ((Tc2j(j - 1)
+ Tc2j(j)) / 2#) _
+ ((Rc1j(j - 1) + Rwcj + Rci(j - 1)) / Rpj(j - 1)) * ((Th1j(j - 1) + Th1j(j))
/ 2#)
'
'每排功率
Qi(j - 1) = (Th1j(j - 1) - Tvj(j - 1)) / ((Rhj(j - 1) + Rwhj + Rhi(j
- 1)) * 1000#)
'(Whj * (Th1j(j - 1) - Th1j(j))) / 3600#
'单管功率
Qi1Bi(j - 1) = Qi(j - 1) / Bi(j - 1)
'壁温
Twj(j - 1) = (Th1j(j) + Th1j(j - 1)) / 2# - Qi(j - 1) * 1000# / (hhfe *
Ahh * Lh * B)
'携带功率
' (j)
Next j
End Sub
Sub TemRow(Tc21 As Single)
Dim NTU, Rcj, Esmj As Single
Dim j As Integer
'Tc2 = Tc21
Mh = Denhf0 * Vh
Mc = Dencf0 * Vc
FhotTem (Thf)
FcoolTem (Tcf)
Whj = Mh * Chp
Wcj = Mc * Ccp
Wmaxj = Whj
Wminj = Wcj
If Whj < Wcj Then
Wmaxj = Wcj
Wminj = Whj
Else
Wmaxj = Whj
Wminj = Wcj
End If
'NTU = UH * (Ahh * Lh + Ahc * Lc) * B / Wminj
NTU = 0.1117
Rcj = Wminj / Wmaxj
Esmj = (1 - Exp(-NTU * (1 - Rcj))) / (1 - Rcj * Exp(-NTU * (1 - Rcj)))
'赋初值
Tc2j(0) = Tc21
Th1j(0) = Th1
'第一排
If Whj > Wcj Then 'j-1
Tc2j(1) = (Tc2j(0) - Esmj * Th1j(0)) / (1 - Esmj)
Th1j(1) = Th1j(0) - Wcj * (Tc2j(0) - Tc2j(1)) / Whj
Else 'j+1
Tc2j(1) = (Tc2j(0) - Rcj * Esmj * Th1j(0)) / (1# - Rcj * Esmj)
Th1j(1) = Th1j(0) - Esmj * (Th1j(0) - Tc2j(0))
End If
'逐排计算
Rwhj = 1# / (2# * Pi * landahw * Lh) * Log(D0 / Di)
Rwcj = 1# / (2# * Pi * landacw * Lc) * Log(D0 / Di)
For j = 1 To M
If Whj > Wcj Then 'j-1
Esmj = (Tc2j(j - 1) - Tc2j(j)) / (Th1j(j - 1) - Tc2j(j))
Tc2j(j + 1) = (Tc2j(j) - Esmj * Th1j(j)) / (1 - Esmj)
Th1j(j + 1) = Th1j(j) - Wcj * (Tc2j(j) - Tc2j(j + 1)) / Whj
Else
Esmj = (Th1j(j) - Th1j(j + 1)) / (Th1j(j) - Tc2j(j - 1))
Tc2j(j + 1) = (Tc2j(j) - Rcj * Esmj * Th1j(j)) / (1# - Rcj * Esmj)
Th1j(j + 1) = Th1j(j) - Esmj * (Th1j(j) - Tc2j(j - 1))
End If
Next j
'Tc2j(j + 1) = Tc1
End Sub
Private Sub Command3_Click()
With DatRow.Recordset
.FindFirst ("Proname = " & "'" & Proname & "'")
If Not .NoMatch Then
Do While Not .EOF
.Delete
.MoveNext
Loop
End If
End With
Unload frmresult
Unload frmain
Unload Me
End Sub
责任编辑: banye
参与评论