晨怡热管 >> 资料积累 >> 热管研究 >> 热管空气换热器计算程序源代码

热管空气换热器计算程序源代码

晨怡热管 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
责任编辑: banye 参与评论
本站地图|热管配套|企业邮局|产品说明

Copyright © 1996-2010 China Harbin DawnHappy Heat Pipe Technology Co., Ltd.
哈尔滨晨怡热管技术有限公司   电话:0451-82589558 82589508 82589538   传真:0451-82552085 技术支持:13704813968
地址:哈尔滨市南岗区南通大街256号  邮编:150001  电子信箱:heatpipe@yahoo.cn   heat-pipe@hotmail.com heat.pipe@yahoo.com.cn 
本站永久域名:http://china-heatpipe.net     http://heatpipe.net.cn    http://rg.nx8.net     http://nx8.net  
中华人民共和国信息产业部ICP/IP地址信息备案:黑ICP备07500228  哈尔滨市公安局国际联网备案登记:哈公网监备23010002001165

Powered By: KingCMS 3.0 Beta