dqwdd.txt

大气稳定度、混合层厚度计算,本软件的计算方法是按照GB/T3840-91规定处理

Const PI = 3.1415926
Const PP = 0.0174533
Dim A_S, A_S0, Mix_Hei

Private Sub Form_Load()
Caption = "大气稳定度、混合层厚度计算----------重庆：王中 2006.09.10"

For ii = 2000 To 2020: Combo1.AddItem ii: Next ii
For ii = 1 To 12: Combo2.AddItem ii: Next ii
For ii = 1 To 31: Combo3.AddItem ii: Next ii
For ii = 1 To 24: Combo4.AddItem ii: Next ii
For ii = 0 To 10: Combo5.AddItem ii: Next ii
For ii = 0 To 10: Combo6.AddItem ii: Next ii

Combo1.Text = Year(Date): Combo2.Text = Month(Date): Combo3.Text = Day(Date): Combo4.Text = Hour(Time)
Combo5.Text = 10: Combo6.Text = 10
Option4.Value = True
Text1.Text = 106.48
Text2.Text = 29.52
End Sub
Private Sub Command2_Click()
 rr = MsgBox("本软件的计算方法是按照GB/T3840-91规定处理" + vbTab + vbCrLf _
            + vbTab + vbCrLf + "由重庆市气象科学研究所 王中 编写，不妥之处敬请指正" + vbTab + vbCrLf + vbTab + vbCrLf + "[e-mail] " + " 023-89116119", , "帮助")
End Sub

Private Sub Command4_Click() '修改或添加原始数据文件
Form2.Show

End Sub

Private Sub Command5_Click() '批处理计算
FILE1 = App.Path & "\data\JG_DATA.TXT"
file0 = App.Path & "\data\DM_DATA.TXT"
Open FILE1 For Output As 2
Print #2, "  年月日时      经度   纬度   稳定度等级  混合层厚度 "
If Dir(file0) <> "" Then
Open file0 For Input As 1
Line Input #1, aaaa
Line Input #1, bbbb
Do While Not EOF(1)
Input #1, riqi
If Len(riqi) > 0 Then
Input #1, LON0, LAT0, DQ, TOTAL, DI, Wind0
NIAN = Mid$(riqi, 1, 4): YUE = Mid$(riqi, 5, 2): RI = Mid$(riqi, 7, 2): SHI = Mid$(riqi, 9, 2)

Call HHGD_DATA(NIAN, YUE, RI, SHI, LON0, LAT0, DQ, TOTAL, DI, Wind0)
 Print #2, riqi; " "; LON0; " "; LAT0; "   "; A_S; "("; A_S0; ")     "; Int(Mix_Hei)
End If
Loop
Close #1
End If
Close #2
MsgBox ("计算完成!")
End Sub


Private Sub Command1_Click() '单站计算
LON = Val(Text1.Text): LAT = Val(Text2.Text)
NIAN = Val(Combo1.Text): YUE = Val(Combo2.Text): RI = Val(Combo3.Text): SHI = Val(Combo4.Text)
T_C = Val(Combo5.Text): L_C = Val(Combo6.Text)
Wind = Val(Text3.Text)
If Option1.Value = True Then DQ = 1 '1号地区
If Option2.Value = True Then DQ = 2 '2号地区
If Option3.Value = True Then DQ = 3 '3号地区
If Option4.Value = True Then DQ = 4 '4号地区

Call HHGD_DATA(NIAN, YUE, RI, SHI, LON, LAT, DQ, T_C, L_C, Wind)

JG = MsgBox("大气稳定度等级：" + A_S + " (" + A_S0 + ") " + vbTab + vbCrLf + _
            vbCrLf + "混合层厚度" + Str(Int(Mix_Hei)) + "m", , "计算结果显示")


End Sub
Sub HHGD_DATA(YYYY, MM, DD, TT, LON, LAT, DQ, T_C, L_C, Wind)
S_O = Sun_Obli(YYYY, MM, DD)       '太阳倾角
S_H = Sun_Hei(LON, LAT, TT, S_O)   '太阳高度角
S_R = SUN_Rad(T_C, L_C, S_H)        '太阳辐射等级
A_S = Air_Safe(Wind, S_R)           '大气稳定度的等级

If A_S = "A" Then A_S0 = "强不稳定"
If A_S = "B" Then A_S0 = "不稳定"
If A_S = "C" Then A_S0 = "弱不稳定"
If A_S = "D" Then A_S0 = "中性"
If A_S = "E" Then A_S0 = "较稳定"
If A_S = "F" Then A_S0 = "稳定"  '当地大气

 '混合层厚度计算
f = 2 * 7.29 * 0.00001 * Sin(LAT * PP) '地转参数
If Wind >= 6 Then Wind = 6
   
If DQ = 1 Then '一号地区
    If A_S = "A" Or A_S = "B" Or A_S = "C" Or A_S = "D" Then
     If A_S = "A" Then a0 = 0.09  '混合层系数
     If A_S = "B" Then a0 = 0.067
     If A_S = "C" Then a0 = 0.041
     If A_S = "D" Then a0 = 0.031
     Mix_Hei = a0 * Wind / f
    End If
End If
   
If DQ = 2 Then  '二号地区
    If A_S = "A" Or A_S = "B" Or A_S = "C" Or A_S = "D" Then
     If A_S = "A" Then a0 = 0.073  '混合层系数
     If A_S = "B" Then a0 = 0.06
     If A_S = "C" Then a0 = 0.041
     If A_S = "D" Then a0 = 0.019
     Mix_Hei = a0 * Wind / f
    End If
End If
   
If DQ = 3 Then  '三号地区
    If A_S = "A" Or A_S = "B" Or A_S = "C" Or A_S = "D" Then
     If A_S = "A" Then a0 = 0.056  '混合层系数
     If A_S = "B" Then a0 = 0.029
     If A_S = "C" Then a0 = 0.02
     If A_S = "D" Then a0 = 0.012
     Mix_Hei = a0 * Wind / f
    End If
  End If

If DQ = 4 Then  '四号地区
    If A_S = "A" Or A_S = "B" Or A_S = "C" Or A_S = "D" Then
     If A_S = "A" Then a0 = 0.073  '混合层系数
     If A_S = "B" Then a0 = 0.048
     If A_S = "C" Then a0 = 0.041
     If A_S = "D" Then a0 = 0.022
     Mix_Hei = a0 * Wind / f
    End If
End If

If A_S = "E" Or A_S = "F" Then
     If A_S = "E" Then b0 = 1.66   '混合层系数
     If A_S = "F" Then b0 = 0.7
     Mix_Hei = b0 * Sqr(Wind / f)
 End If
'JG = MsgBox("大气稳定度等级：" + A_S + " (" + A_S0 + ") " + vbTab + vbCrLf + _
            vbCrLf + "混合层厚度" + Str(Int(Mix_Hei)) + "m", , "计算结果显示")

End Sub
Private Sub Command3_Click()
End
End Sub
Function Sun_Obli(N, Y, R) '算出太阳倾角：Sun_Obli
Dim D0 As Date, D1 As Date
D0 = DateSerial(N, 1, 1)  '当年的第一天
D1 = DateSerial(N, Y, R) '当天日期
Dn = DateValue(D1) - DateValue(D0) 'Dn:一年中日期序数，0，1，2，……，365。
q = 6.2832 * Dn / 365
B = (0.006918 - 0.399912 * Cos(q) + 0.070257 * Sin(q) - 0.006758 _
             * Cos(2 * q) + 0.000907 * Sin(2 * q) - 0.002697 * Cos(3 * q) _
             + 0.00148 * Sin(3 * q))
BB = B / Sqr((1 - B * B))
Sun_Obli = Atn(BB) * 180 / PI   '太阳倾角
End Function
Function Sun_Hei(LON, LAT, Tim, Sun_Obli) '算出太阳高度角:Sun_Hei
'Lon:当地经度(deg), Lat:当地纬度(deg), Tim:北京时间(h)
  X = Sin(LAT * PP) * Sin(Sun_Obli * PP) + Cos(LAT * PP) * Cos(Sun_Obli * PP) _
      * Cos((15 * Tim + LON - 300) * PP)
  Sun_Hei = Atn(X / (1 - X * X) ^ 0.5) * 180 / PI
End Function
Function SUN_Rad(T_C, L_C, S_H) '由太阳高度角和云量查出太阳辐射等级:SUN_Rad
'T_C:总云量（全天空十分制）,L_C:低云量 , S_H:太阳高度角
If T_C <= 4 And L_C <= 4 Then
   If S_H <= 0 Then SUN_Rad = -2
   If S_H > 0 And S_H <= 15 Then SUN_Rad = -1
   If S_H > 15 And S_H <= 35 Then SUN_Rad = 1
   If S_H > 35 And S_H <= 65 Then SUN_Rad = 2
   If S_H > 65 Then SUN_Rad = 3
End If
If T_C >= 5 And T_C <= 7 And L_C <= 4 Then
   If S_H <= 0 Then SUN_Rad = -1
   If S_H > 0 And S_H <= 15 Then SUN_Rad = 0
   If S_H > 15 And S_H <= 35 Then SUN_Rad = 1
   If S_H > 35 And S_H <= 65 Then SUN_Rad = 2
   If S_H > 65 Then SUN_Rad = 3
End If
If T_C >= 8 And L_C <= 4 Then
   If S_H <= 0 Then SUN_Rad = -1
   If S_H > 0 And S_H <= 15 Then SUN_Rad = 0
   If S_H > 15 And S_H <= 35 Then SUN_Rad = 0
   If S_H > 35 And S_H <= 65 Then SUN_Rad = 1
   If S_H > 65 Then SUN_Rad = 1
End If
If T_C >= 5 And L_C >= 4 And L_C <= 7 Then
   SUN_Rad = 0
   If S_H > 65 Then SUN_Rad = 1
End If
If T_C >= 8 And L_C >= 8 Then SUN_Rad = 0

End Function
Function Air_Safe(Wind, S_R)  '大气稳定度的等级:Air_Safe
'Wind 地面10m高度处10分钟平均风速 ,S_R 太阳辐射等级
If Wind <= 1.9 Then
  If S_R = 3 Then Air_Safe = "A"
  If S_R = 2 Then Air_Safe = "A"
  If S_R = 1 Then Air_Safe = "B"
  If S_R = 0 Then Air_Safe = "D"
  If S_R = -1 Then Air_Safe = "E"
  If S_R = -2 Then Air_Safe = "F"
End If
If Wind >= 2 And Wind <= 2.9 Then
  If S_R = 3 Then Air_Safe = "A"
  If S_R = 2 Then Air_Safe = "B"
  If S_R = 1 Then Air_Safe = "C"
  If S_R = 0 Then Air_Safe = "D"
  If S_R = -1 Then Air_Safe = "E"
  If S_R = -2 Then Air_Safe = "F"
End If
If Wind >= 3 And Wind <= 4.9 Then
  If S_R = 3 Then Air_Safe = "B"
  If S_R = 2 Then Air_Safe = "B"
  If S_R = 1 Then Air_Safe = "C"
  If S_R = 0 Then Air_Safe = "D"
  If S_R = -1 Then Air_Safe = "D"
  If S_R = -2 Then Air_Safe = "E"
End If
If Wind >= 5 And Wind <= 5.9 Then
  Air_Safe = "D"
  If S_R = 3 Or S_R = 2 Then Air_Safe = "C"
End If
If Wind >= 6 Then Air_Safe = "D"

End Function