公路交通噪声预测JTJ 005-96

Dim rl, rm, rs, K1, K2 '定义大中小型车系数

Dim R2  '昼夜比

Dim TOTAL '总的车流量

Dim r(11) As Integer '预测点距路面距离

Dim laeq123(11) As Single

Dim laeq333(11) As Single



Private Sub Command1_Click()

    公路噪声预测帮助文档3.Show

End Sub



Private Sub Command2_Click()

    TOTAL = Text5.Text

    width1 = Text7.Text

    rl = Text2.Text

    rm = Text3.Text

    rs = Text4.Text

    R2 = Text8.Text

    rate1 = Text6.Text

    rate2 = Text11.Text '视角

    laeq5 = Text13.Text

    laeq6 = Text14.Text



    For K = 1 To 11 Step 1

        i = K



        'Print r(i)



        '折算各类车型昼/夜间流量

        xs1 = Text4.Text

        Xm1 = Text3.Text

        Xl1 = Text2.Text

        Xs2 = Text12.Text

        Xm2 = Text8.Text

        Xl2 = Text5.Text



        If xs1 < 100 Then

            xs1 = 100

        Else

        End If



        '求各类车型昼/夜间行驶车速

        Vs1 = 237 (xs1 ^ -0.1602) '昼间小型车速计算

        Vm1 = 212 (Xm1 ^ -0.1747) '昼间中型车速计算

        Vl1 = 0.8 Vm1 '昼间大型车速计算



        Vs2 = 0.8 Vs1  '夜间小型车速计算

        Vm2 = 0.8 Vm1    '夜间中型车速计算

        Vl2 = 0.8 Vl1  '夜间大型车速计算



        '求各类车型昼间噪声级

        Lwl1 = 77.2 + 0.18 Vl1 '昼间大型车车速

        Lwm1 = 62.6 + 0.32 Vm1 '昼间中型车车速

        Lws1 = 59.3 + 0.23 Vs1 '昼间小型车车速



        '求各类车型夜间噪声级

        Lwl2 = 77.2 + 0.18 Vl2 '夜间大型车车速

        Lwm2 = 62.6 + 0.32 Vm2 '夜间中型车车速

        Lws2 = 59.3 + 0.23 Vs2 '夜间小型车车速



        '昼/夜间距离衰减量的计算



        '一计算I型车昼夜间的车间间距D

        DS1 = 1000 Vs1 / xs1 '昼间小型车D

        DM1 = 1000 Vm1 / Xm1 '昼间中型车D

        DL1 = 1000 Vl1 / Xl1 '昼间大型车D

        DS2 = 1000 Vs2 / Xs2 '夜间小型车D

        DM2 = 1000 Vm2 / Xm2 '夜昼间中型车D

        DL2 = 1000 Vl2 / Xl2 '夜昼间大型车D



        '二预测点到等效行车线的距离

        RS1 = Sqr((r(i) + width1 0.5) (r(i) + 3.5 width1))

        RM1 = RS1

        RL1 = RS1

        RM2 = RS1

        RL2 = RS1

        RS2 = RS1



        '设K1,K2值!

        If r(i) = 20 Then

            K2 = 0.17

        ElseIf r(i) = 30 Then

            K2 = 0.617

        ElseIf r(i) = 40 Then

            K2 = 0.716

        ElseIf r(i) = 50 Then

            K2 = 0.78

        ElseIf r(i) = 60 Then

            K2 = 0.806

        ElseIf r(i) = 70 Then

            K2 = 0.833

        ElseIf r(i) = 80 Then

            K2 = 0.84

        ElseIf r(i) = 100 Then

            K2 = 0.855

        ElseIf r(i) = 140 Then

            K2 = 0.88

        ElseIf r(i) = 160 Then

            K2 = 0.885

        ElseIf r(i) = 250 Then

            K2 = 0.89

        Else

        End If



        '小型车昼夜间距离衰减量

        If RS1 < DS1 / 2 Then

            LS1 = K1 K2 20 Log(RS1 / 7.5) / Log(10)

            ls2 = K1 K2 20 Log(RS2 / 7.5) / Log(10)

        ElseIf RS1 > DS1 / 2 Then

            LS1 = 20 K1 (K2 Log(0.5 DS1 / 7) / Log(10) + Log(Sqr(RS1 / 0.5 DS1)) / Log(10))

            ls2 = 20 K1 (K2 Log(0.5 DS2 / 7) / Log(10) + Log(Sqr(RS2 / 0.5 DS2)) / Log(10))

        Else

        End If

        If RM1 < DM1 / 2 Then

            LM1 = K1 K2 20 Log(RM1 / 7.5) / Log(10)

            LM2 = K1 K2 20 Log(RM2 / 7.5) / Log(10)

        ElseIf RM1 > DM1 / 2 Then

            LM1 = 20 K1 (K2 Log(0.5 DM1 / 7) / Log(10) + Log(Sqr(RM1 / 0.5 DM1)) / Log(10))

            LM2 = 20 K1 (K2 Log(0.5 DM2 / 7) / Log(10) + Log(Sqr(RM2 / 0.5 DM2)) / Log(10))

        Else

        End If



        If RL1 < DL1 / 2 Then

            LL1 = K1 K2 20 Log(RL1 / 7.5) / Log(10)

            LL2 = K1 K2 20 Log(RL2 / 7.5) / Log(10)

        ElseIf RL1 > DL1 / 2 Then

            LL1 = 20 K1 (K2 Log(0.5 DL1 / 7) / Log(10) + Log(Sqr(RL1 / 0.5 DL1)) / Log(10))

            LL2 = 20 K1 (K2 Log(0.5 DL2 / 7) / Log(10) + Log(Sqr(RL2 / 0.5 DL2)) / Log(10))

        Else

        End If



        '求纵坡修正系数

        LLZP = 98 rate1

        LMZP = 73 rate1

        LSZP = 50 rate1



        '路面修正量

        If Option4.Value = True Then

            laeq2 = 0

        Else

        End If



        If Option5.Value = True Then

            laeq2 = 2

        Else

        End If



        '计算I型车昼/夜间预测点接收到了噪声值

        LAEQS1 = Lws1 + 10 Log(xs1 / Vs1) - LS1 - 13 + LSZP + laeq2 - laeq5 - laeq6

        LAEQM1 = Lwm1 + 10 Log(Xm1 / Vm1) - LM1 - 13 + LMZP + laeq2 - laeq5 - laeq6

        LAEQL1 = Lwl1 + 10 Log(Xl1 / Vl1) - LL1 - 13 + LLZP + laeq2 - laeq5 - laeq6



        LAEQS2 = Lws2 + 10 Log(Xs2 / Vs2) - ls2 - 13 + LSZP + laeq2 - laeq5 - laeq6

        LAEQM2 = Lwm2 + 10 Log(Xm2 / Vm2) - LM2 - 13 + LMZP + laeq2 - laeq5 - laeq6

        LAEQL2 = Lwl2 + 10 Log(Xl2 / Vl2) - LL2 - 13 + LLZP + laeq2 - laeq5 - laeq6



        '最终预测点接收到各型车噪声值叠加计算

        laeq = 10 Log(10 ^ (0.1 LAEQS1) + 10 ^ (0.1 LAEQM1) + 10 ^ (0.1 LAEQL1)) / Log(10)



        laeq22 = 10 Log(10 ^ (0.1 LAEQS2) + 10 ^ (0.1 LAEQM2) + 10 ^ (0.1 LAEQL2)) / Log(10)

        '有限长度公路引起的修正量

        laeq1 = -10 * Log(rate2 / 180) / Log(10)

        laeq = laeq - laeq1

        laeq22 = laeq22 - laeq1

        laeq123(i) = laeq

        laeq333(i) = laeq22



    Next K



    For i = 1 To 11

        MYSTR = Format(laeq123(i), "###,##0.00")

        MYSTR1 = Format(laeq333(i), "###,##0.00")

        MYSTR3 = Format(r(i), "###,##0.00")

        LEN1 = Len(MYSTR)

        LEN2 = Len(MYSTR1)

        LEN3 = Len(MYSTR3)

        If LEN3 > LEN1 Then



            AA = AA & Space(LEN3 - LEN1) & MYSTR & "  "

            bb = bb & Space(LEN3 - LEN1) & MYSTR1 & "  "

            cc = cc & MYSTR3 & "  "

        Else

            AA = AA & MYSTR & "  "

            bb = bb & MYSTR1 & "  "

            cc = cc & MYSTR3 & "  "

        End If

    Next i



    '格式化输出结果



    LEN123 = Len(AA)

    LEN124 = Len(Text10.Text)

    YY = Space((LEN123 - LEN124) / 2)

    kk = Text1.Text

    DD = Str(kk)



    RichTextBox1.Text = YY & Text10.Text & "有限长路段" & DD & "年预测结果" & vbLf & "  预测点距公路位置：" & cc & vbLf & "  预测点昼间预测值：" & AA & vbLf & "  预测点夜间预测值：" & bb



End Sub



Private Sub Command3_Click()

    Unload Me

End Sub



Private Sub Form_Load()

    Option2.Value = True

    Option4.Value = True

    r(1) = 20

    r(2) = 30

    r(3) = 40

    r(4) = 50

    r(5) = 60

    r(6) = 70

    r(7) = 80

    r(8) = 100

    r(9) = 140

    r(10) = 160

    r(11) = 250

End Sub



Private Sub Option1_Click()

    K1 = 0.9

End Sub



Private Sub Option2_Click()

    K1 = 1#

End Sub



Private Sub Option3_Click()

    K1 = 1.1

End Sub