module1.bas

水利计算程序!年径流量!调节计算!调洪计算.

Attribute VB_Name = "Module1"
Option Explicit

Global Const e = 1#  '等出力试算了的精度
Global Const e1 = 1#  '最低水库蓄水量与V死相差之精度
Global Const ak = 8.5 '出力系数
Public App1 As String
Public gzz() As Single, gvv() As Single
Public gz1() As Single, gqq() As Single
'V:兴利库容
Public v As Single
'mmg:水位—库容数据组数,nng:水位—流量数据组数,m:data文件中数据组数, a():第I年第J时段的入库流量
Public mmg As Integer, nng As Integer, m As Integer, a() As Single
'i0:起始年号,ii0:多年平均流量
Public i0 As Integer, ii0 As Integer, kk As Integer
Public iis As Integer, ie As Integer
'iss(): 第I年的供水期开始, iee():第I年的的供水期结束
Public iee() As Integer, iss() As Integer
Public ig() As Integer
Public zz As Single '正常高水位
Public zzs As Single    '死水位
Public mm As Integer, Qdes() As Single

Public Function ReadFile()
      Dim i As Integer, j As Integer
      Dim Filenum As Integer
      Filenum = FreeFile
      App1 = App.Path
      
      Open App1 & "\Z_V.dat" For Input As #Filenum '库容曲线，水位 m ; 库容: m3/s*月
      Input #Filenum, mmg
      ReDim gzz(mmg), gvv(mmg)
      For i = 1 To mmg
          Input #Filenum, gzz(i), gvv(i)
      Next i
      Close #Filenum
      Filenum = FreeFile
      Open App1 & "\Z_Q.dat" For Input As #Filenum '下游水位流量关系
      Input #Filenum, nng
      ReDim gz1(nng), gqq(nng)
      For i = 1 To nng
        Input #Filenum, gz1(i), gqq(i)
     Next i
     Close #Filenum
End Function
'计算每月用于发电的流量
Public Sub CaluFlow()
     Dim i As Integer, j As Integer
         For i = 1 To m
           For j = 1 To 12
               If j = 2 Then
                   a(i, j) = a(i, j) - 22    '5月灌溉用水量和船闸用水
               ElseIf (j > 2 And j < 7) Then
                   a(i, j) = a(i, j) - 45    '6~9月灌溉用水量和船闸用水
               Else
                   a(i, j) = a(i, j) - 10    '船闸操作耗用流量
               End If
            Next j
          Next i
End Sub
Public Sub 插值图(m As Integer, y() As Single, x() As Single, x0 As Single, y0 As Single)
   Dim i As Integer, inn As Integer
   Dim a1 As Single

   If x0 < x(1) Then '库容的最低水位 '或者不超出下泄能力
      y0 = y(1)
      Exit Sub
   End If
   If x0 > x(m) Then '库容的最高水位 '或者不超出下泄能力
      y0 = y(m)
      Exit Sub
   End If
   For i = 1 To m - 1
       If (x(i) < x0 And x(i + 1) >= x0) Then
           inn = i   '找出110所在组数7
           Exit For
       End If
   Next i
   a1 = (x0 - x(inn)) / (x(inn + 1) - x(inn))  'a1:内插系数
   y0 = y(inn) + a1 * (y(inn + 1) - y(inn))  '正常高水位对应的库容 '多年平均流量*0.8后对应的下游水位
End Sub
Public Sub 排频(n As Integer, x() As Single, p() As Single)
  Dim dw() As Single, lq() As Integer
  Dim i As Integer, j As Integer
  Dim ap As Single, lk As Integer
  ReDim dw(n), lq(n)
  For i = 1 To n
      dw(i) = x(i) '每年的调节流量
      lq(i) = i '相对应的组数
      Debug.Print dw(i), lq(i)
  Next i
  
  For i = 1 To n
      For j = i + 1 To n
          If dw(j) > dw(i) Then
            ap = dw(i)
            lk = lq(i)
            dw(i) = dw(j)
            lq(i) = lq(j)
            dw(j) = ap
            lq(j) = lk
         End If
       Next j
    Next i
    For i = 1 To n
      p(lq(i)) = CSng(i) / (n + 1) * 100
    Next i
    For i = 1 To n
        Debug.Print p(i)
    Next i
End Sub
Public Sub floodFile()
On Error GoTo Errorhandler
Dim i As Integer
Dim Filenum As Integer
Filenum = FreeFile
Open App.Path & "\FLOOD_" & frmFloodProceed.Combo1.Text & ".dat" For Input As #Filenum
Input #Filenum, mm
ReDim Qdes(mm)
For i = 1 To mm
    Input #Filenum, Qdes(i) ' I时刻入库流量
Next i
Close #Filenum
Errorhandler:
    Select Case Err.Number
        Case 53
        MsgBox "没有找到相应的入库洪水文件！"
    End Select
End Sub
Public Function ReadRunoff() '多年平均流量
Dim q0 As Single
Dim aa As Integer, b As Single
Dim i As Integer, j As Integer
Dim Filenum As Integer
Filenum = FreeFile
Open App1 & "\data.dat" For Input As #Filenum '径流序列资料 （老系列）
Input #Filenum, m, i0, ii0
ReDim a(m, 12)
q0 = 0
For i = 1 To m
    Input #Filenum, aa
    For j = 1 To 12
       Input #Filenum, a(i, j) 'a():第I年第J时段的入库流量
    Next j
    Input #Filenum, b
    q0 = q0 + b / CSng(m) '多年平均流量
Next i
Close #Filenum
ReadRunoff = q0
End Function
Public Sub ReadRunoff1()
Dim aa As Integer, b As Single
Dim i As Integer, j As Integer
Dim Filenum As Integer
Filenum = FreeFile
Open (App1 & "\data1.dat") For Input As #Filenum '保证年份的径流序列（从DATA.DAT中剔除破坏年份）
Input #Filenum, m, i0, ii0
ReDim a(m, 12)
For i = 1 To m
    Input #Filenum, aa
    For j = 1 To 12
       Input #Filenum, a(i, j) 'a():第I年第J时段的入库流量
    Next j
    Input #Filenum, b
Next i
Close #Filenum
End Sub