《基础水文数据库》应用软件-水文预报中PA值计算

http://dl2.csdn.net/down4/20070627/27214747569.rar

编制水文预报 方案过程中，需要计算PA值，也就是前期影响，这个软件（代码）直接读取《基础水文数据库》（ODBC方式）和权重，计算区间PA值。

实际效果：本软件在2007年淮河预报方案（信阳）修订过程中，投入使用，节约了大量时间，软件稳定可靠。

软件安装：

南方片资料整汇编软件+本软件

需要声明的是：你的数据库中要有历史数据。

使用方法：在已经安装南方片软件的情况下，复制就可以使用，在使用前请配置COFIG.ini文件

1 在“预报站点分布图”中填加雨量点比如

息县=息县,50220150,50220350,50220550,50220750,50220850,50221900,50222450,50225600,50222850,50223650,50223900,50225350,50224350,50224650,50224750,50225050

2 在“预报站点权重”写上权重，比如

长台关=0.095,0.126,0.117,0.118,0.107,0.089,0.114,0.18,0.054

3 在“预报雨量PA时段”增加预报时段，也就是需要计算的时间，比如

长台关=2000,20000505,20000828,0,2002,20020501,20020625,0,2003,20030701,20031005,70,2004,20040629,20040803,0,2005,20050605,20050828,0

4 在“预报雨量PA特征值”增加 修改产流参数K、Im值，比如

长台关=0,70,.93,.93,.93,.93,.93,.85,.85,.85,.85,.85,.93,.93

然后就可以计算了

附录部分源代码

Private Sub cmd_预报_PA_Click()
'预报雨量PA时段

Dim SqlTemp As String
Dim StrLine As String
Dim 临时年份 As String
Dim 临时起月日 As String
Dim 临时止月日 As String
Dim 站号列表() As String
Dim ii, jj, KK As Long
Dim 数据列表() As String
Dim 时段雨量合计 As Double
Dim 极值日期(4) As String '最大日期，最大时间，最小日期，最小时间
Dim 总行数 As Long
Dim 数据排序(5000, 5) As String
Dim PA特征表() As String
Dim StartDateTime As Date
Dim EndDateTime As Date
Dim kkk, jjj, iii, lll As Integer
Dim 时间指针 As Date

On Error GoTo errorER

SqlTemp = "DP"
If Len(SqlTemp) < 1 Then 漂浮提示 "哈哈 请选择 表": Exit Sub
' SQLTEMP = Mid(SQLTEMP, InStr(SQLTEMP, "<") + 1, InStr(SQLTEMP, ">") - InStr(SQLTEMP, "<") - 1)
站号列表 = Split(FCm_预报_站.Text, ",")
StrLine = GetValue(App.path & "/config.ini", "预报雨量PA特征值", 站号列表(0), "")
PA特征表 = Split(StrLine, ",")
'GoTo 900
DrawProcEx Picture5, 1 / 100, &H800000, "连接数据库": DoEvents
mnucnrsOpen (0)
Open App.path & "/" & 站号列表(0) & "前期影响雨量文件.txt" For Output As #1
For i = 1 To LV_预报_PA.ListItems.Count 'N个场次

临时年份 = Left(LV_预报_PA.ListItems(i), 4)
临时起月日 = Mid(LV_预报_PA.ListItems(i).SubItems(1), 5, 4)
临时止月日 = Mid(LV_预报_PA.ListItems(i).SubItems(2), 5, 4)
PA特征表(0) = (LV_预报_PA.ListItems(i).SubItems(3))

If Chk_预报_PA调过读取数据库.Value = 1 Then GoTo 880
StartDateTime = CDate(临时年份 & "-" & Left(临时起月日, 2) & "-" & Right(临时起月日, 2)) ' & " " & Mid(LV_预报_PA.ListItems(i).SubItems(1), 9, 2) & ":00")
EndDateTime = CDate(临时年份 & "-" & Left(临时止月日, 2) & "-" & Right(临时止月日, 2)) '& " " & Mid(LV_预报_场次.ListItems(i).SubItems(2), 9, 2) & ":00")
时间指针 = StartDateTime
' For iii = 0 To UBound(权重列表) + 2
' 数据排序(iii, 1) = ""
' Next
KK = DateDiff("d", StartDateTime, EndDateTime)
For kkk = 0 To KK
数据排序(kkk, 0) = Format(DateAdd("d", kkk, StartDateTime), "yyyy-mm-dd")
Next

For k = 0 To UBound(站号列表()) - 1
DrawProcEx Picture5, k / (UBound(站号列表()) - 1), &H800000, "读取数据库数据": DoEvents
LV_预报_PA.ListItems(i).Selected = True
LV_预报_PA.SetFocus

rStr = "SELECT Distinct * FROM " & SqlTemp & _
" where stcd like '" & 站号列表(k + 1) & _
"'and yr like '" & 临时年份 & _
"'and mO >= '" & (Int(临时起月日 / 100)) & "' and mO <= '" & (Int(临时止月日 / 100)) & _
"' Order by mo"
rs.Open rStr, cn, CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockOptimistic, adCmdText
If (Not rs.BOF And Not rs.EOF) Then
rs.MoveFirst
Do While (Not rs.BOF And Not rs.EOF)

For j = 3 To rs.Fields.Count - 2 Step 2
时间指针 = CDate(rs(1) & "-" & rs(2) & "-01")
KK = Day(DateAdd("d", -1, DateAdd("m", 1, 时间指针))) '每个月最后的日期
If ((j - 1) / 2) <= KK Then
时间指针 = CDate(rs(1) & "-" & rs(2) & "-" & ((j - 1) / 2))
KK = DateDiff("d", StartDateTime, 时间指针)
If ((rs(j) & "") <> "") Then

If KK >= 0 Then
If KK = 0 Then '第一条记录
数据排序(KK, 1) = IIf((Val(rs(j)) + Val(PA特征表(0))) * Val(PA特征表(Val(rs(2)) + 1)) > Val(PA特征表(1)), Val(PA特征表(1)), (Val(rs(j)) + Val(PA特征表(0))) * Val(PA特征表(Val(rs(2)) + 1)))

数据排序(KK, 0) = 数据排序(KK, 0) & "," & rs(j) & "," & PA特征表(0)
Else
If Day(时间指针) = 1 Then '每个月1日 是前一个月雨量
数据排序(KK, 1) = IIf((Val(rs(j)) + Val(数据排序(KK - 1, 1))) * Val(PA特征表(Val(rs(2)))) > Val(PA特征表(1)), Val(PA特征表(1)), (Val(rs(j)) + Val(数据排序(KK - 1, 1))) * Val(PA特征表(Val(rs(2)))))
数据排序(KK, 0) = 数据排序(KK, 0) & "," & rs(j) & "," & Format(数据排序(KK - 1, 1), "0.0")
Else
数据排序(KK, 1) = IIf((Val(rs(j)) + Val(数据排序(KK - 1, 1))) * Val(PA特征表(Val(rs(2)) + 1)) > Val(PA特征表(1)), Val(PA特征表(1)), (Val(rs(j)) + Val(数据排序(KK - 1, 1))) * Val(PA特征表(Val(rs(2)) + 1)))
数据排序(KK, 0) = 数据排序(KK, 0) & "," & rs(j) & "," & Format(数据排序(KK - 1, 1), "0.0")
End If
End If
End If
'Print #1, rs(0) & "," & rs(1) & "," & rs(2) & "," & (j - 1) / 2 & ",";
'Print #1, rs(j)
Else
If KK >= 0 Then
If KK = 0 Then '第一条记录
数据排序(KK, 1) = IIf((0 + Val(PA特征表(0))) * Val(PA特征表(Val(rs(2)) + 1)) > Val(PA特征表(1)), Val(PA特征表(1)), (0 + Val(PA特征表(0))) * Val(PA特征表(Val(rs(2)) + 1)))
数据排序(KK, 0) = 数据排序(KK, 0) & ",0," & PA特征表(0)
Else
If Day(时间指针) = 1 Then '每个月1日 是前一个月雨量
数据排序(KK, 1) = IIf((0 + Val(数据排序(KK - 1, 1))) * Val(PA特征表(Val(rs(2)))) > Val(PA特征表(1)), Val(PA特征表(1)), (0 + Val(数据排序(KK - 1, 1))) * Val(PA特征表(Val(rs(2)))))
数据排序(KK, 0) = 数据排序(KK, 0) & ",0," & Format(数据排序(KK - 1, 1), "0.0")
Else
数据排序(KK, 1) = IIf((0 + Val(数据排序(KK - 1, 1))) * Val(PA特征表(Val(rs(2)) + 1)) > Val(PA特征表(1)), Val(PA特征表(1)), (0 + Val(数据排序(KK - 1, 1))) * Val(PA特征表(Val(rs(2)) + 1)))
数据排序(KK, 0) = 数据排序(KK, 0) & ",0," & Format(数据排序(KK - 1, 1), "0.0")

End If
End If
End If
'If kk >= 0 Then 数据排序(kk, 0) = 数据排序(kk, 0) & ","
'Print #1, ""
End If
End If
Next
'Print #1, ""
rs.MoveNext
Loop
End If
'Print #1, ""
mnursClose
Next
KK = DateDiff("d", StartDateTime, EndDateTime)
For kkk = 0 To KK

Print #1, (数据排序(kkk, 0))
Next

' Close #1
' '一个场次一个文件
880: DrawProcEx Picture5, i / (LV_预报_PA.ListItems.Count + 1), &H800000, "整理分析": DoEvents

Next
mnursClose

mnucnClose
Close #1
Close #2
DrawProcEx Picture5, 1 / 1, &H800000, "整理完成": DoEvents
漂浮提示 "累呀，不过还是完成了！"
Exit Sub
errorER:

Close #1
Close #2
漂浮提示 "在测站信息中搜索时遇到了错误 类型:" & str(Err.Number) & vbCrLf
LogSmgText = LogSmgText & "在测站信息中搜索时遇到了错误，类型：" & str(Err.Number) & vbCrLf
MsgBox "在测站信息中搜索时遇到了错误，类型：" & Err.Description, vbOKOnly & vbCritical, "查询信息"
mnursClose
mnucnClose

End Sub