initpop.bas

电力自动化专业领域的一个重要内容

allB(i) = allBU(i)
End If
If (allBx(i) < allBD(i)) Then
allBx(i) = allBD(i)
End If
Next i


For j = 1 To 8
kd(j) = ss(N1, j)
Next j

'寻找固定输出机组
For i = 1 To 8
msj = 1  '时间常数
Do While (initP(i) - msj * UP(i)) > 0
msj = msj + 1
Loop
ifopen = 1
For k = 0 To msj - 1
If ss(k, i) = 0 Then
ifopen = 0
End If
Next k
If ifopen = 1 And ss(msj, i) = 0 Then
For k = 1 To msj - 1
rr(N1 + k - 1, i) = initP(i) - k * UP(i)
kyss(N1 + k - 1, i) = 1
gudingP(N1 + k - 1, i) = rr(N1 + k, i)
Next k
End If
Next i


fhguding = 0
For i = 1 To 8
If (allB(i) < allBx(i)) And (kd(i) = 1) Then
rr(0, i) = UP(i)
kd(i) = 0
fhguding = fhguding + rr(0, i)
End If
Next i

kjnum = 0
For j = 1 To 8
If kd(j) = 1 Then
kjnum = kjnum + 1
End If
Next j
ReDim ZB(1 To 2 * kjnum + 1)
ReDim ZP(1 To kjnum)
m = 2
For j = 1 To 8
If kd(j) = 1 Then
ZB(m) = allB(j)
m = m + 1
End If
Next j
For j = 1 To 8
If kd(j) = 1 Then
ZB(m) = allBx(j)
m = m + 1
End If
Next j
m = 1
For j = 1 To 8
If kd(j) = 1 Then
ZP(m) = allP(j)
m = m + 1
End If
Next j
ZB(1) = fh(N1) - fhguding
sumallB = 0
For i = 1 To 8
If kd(i) = 1 Then
sumallB = sumallB + allB(i)
End If
Next i
If (sumallB < (fh(N1) - fhguding)) Then
For i = 1 To 8
If kd(i) = 1 Then
rr(N1, i) = allB(i)
End If
Next i
GoTo 800
End If

sumallBx = 0
For i = 1 To 8
If kd(i) = 1 Then
sumallBx = sumallBx + allBx(i)
End If
Next i
If (sumallBx > (fh(N1) - fhguding)) Then
For i = 1 To 8
If kd(i) = 1 Then
rr(N1, i) = allBx(i)
End If
Next i
GoTo 800
End If


Call good(kjnum, ZP(), ZB())
If fvalue2 = 0 Then
For i = 1 To 8
If ss(N1, i) = 1 Then
rr(N1, i) = 0
End If
Next i
Else
For i = 1 To 8
BP(i) = 0
Next i
For i = 1 To 2 * kjnum + 1
If (kjnum >= JX(i)) Then
BP(JX(i)) = ZB(i)
End If
Next i
m = 1
For i = 1 To 8
If kd(i) = 1 Then
rr(N1, i) = BP(m)
m = m + 1
End If
If ss(N1, i) = 0 Then
rr(N1, i) = 0
End If
Next i
End If




800: For N1 = 1 To 23
For i = 1 To 8
allB(i) = rr(N1 - 1, i) + UP(i)
allBx(i) = rr(N1 - 1, i) - UP(i)
Next i
For i = 1 To 8
If (allB(i) > allBU(i)) Then
allB(i) = allBU(i)
End If
If (allBx(i) < allBD(i)) Then
allBx(i) = allBD(i)
End If
Next i

For j = 1 To 8
kd(j) = ss(N1, j)
Next j

fhguding1 = 0
For i = 1 To 8
If kyss(N1, i) = 1 Then
kd(i) = 0
fhguding1 = fhguding1 + gudingP(N1, i)
End If
Next i

fhguding = 0
For i = 1 To 8
If (allB(i) < allBx(i)) And (kd(i) = 1) Then
rr(N1, i) = rr(N1 - 1, i) + UP(i)
kd(i) = 0
fhguding = fhguding + rr(N1, i)
End If
Next i


kjnum = 0
For j = 1 To 8
If kd(j) = 1 Then
kjnum = kjnum + 1
End If
Next j
ReDim ZB(1 To 2 * kjnum + 1)
ReDim ZP(1 To kjnum)
m = 2
For j = 1 To 8
If kd(j) = 1 Then
ZB(m) = allB(j)
m = m + 1
End If
Next j
For j = 1 To 8
If kd(j) = 1 Then
ZB(m) = allBx(j)
m = m + 1
End If
Next j
m = 1
For j = 1 To 8
If kd(j) = 1 Then
ZP(m) = allP(j)
m = m + 1
End If
Next j
ZB(1) = fh(N1) - fhguding - fhguding1
sumallBx = 0
For i = 1 To 8
If kd(i) = 1 Then
sumallBx = sumallBx + allBx(i)
End If
Next i
If (sumallBx > (fh(N1) - fhguding - fhguding1)) Then
For i = 1 To 8
If kd(i) = 1 Then
rr(N1, i) = allBx(i)
End If

Next i
GoTo 300
End If

sumallB = 0
For i = 1 To 8
If kd(i) = 1 Then
sumallB = sumallB + allB(i)
End If
Next i
If (sumallB < (fh(N1) - fhguding - fhguding1)) Then
For i = 1 To 8
If kd(i) = 1 Then
rr(N1, i) = allB(i)
End If
Next i
GoTo 300
End If

Call good(kjnum, ZP(), ZB())
If fvalue2 = 0 Then
For i = 1 To 8
If ss(N1, i) = 1 Then
rr(N1, i) = 0
End If
Next i
Else
For i = 1 To 8
BP(i) = 0
Next i
For i = 1 To 2 * kjnum + 1
If (kjnum >= JX(i)) Then
BP(JX(i)) = ZB(i)
End If
Next i
m = 1
For i = 1 To 8
If kd(i) = 1 Then
rr(N1, i) = BP(m)
m = m + 1
End If
If ss(N1, i) = 0 Then
rr(N1, i) = 0
End If
Next i
End If

'寻找固定输出机组
For i = 1 To 8
msj = 1  '时间常数
Do While (rr(N1, i) - msj * UP(i)) > 0
msj = msj + 1
Loop
Dim ifyuejie As Integer
ifyuejie = 0
For k = 1 To msj
If (N1 + k > 23) Then
ifyuejie = 1
End If
Next k
If ifyuejie = 1 Then GoTo 300

ifopen = 1
For k = 1 To msj - 1
If ss(N1 + k, i) = 0 Then
ifopen = 0
End If
Next k
If ifopen = 1 And ss(N1 + msj, i) = 0 Then
For k = 1 To msj - 1
rr(N1 + k, i) = rr(N1, i) - k * UP(i)
kyss(N1 + k, i) = 1
gudingP(N1 + k, i) = rr(N1 + k, i)
Next k
End If
Next i






300:  Next N1
End Sub

'负荷最优分配子程序

Sub good(N As Integer, P() As Double, B() As Double)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim hangshu As Integer
Dim lieshu As Integer
Dim lieshu1 As Integer
Dim izy As Integer
Dim jzy As Integer
Dim Q As Integer
Dim Azuyuan As Integer

hangshu = 2 * N + 1
lieshu = 5 * N + 1
lieshu1 = 3 * N
'给距阵A赋初值:

ReDim A(1 To 2 * N + 1, 1 To 5 * N + 1)
For i = 1 To N
A(1, i) = 1
Next i
For i = 2 To N + 1
A(i, i - 1) = 1: A(i, i + N - 1) = 1
Next i
For i = N + 2 To hangshu
A(i, i + N - 1) = -1: A(i, i - N - 1) = 1
Next i
For i = 1 To hangshu
A(i, 3 * N + i) = 1
Next i

'给向量C赋初值:
ReDim C(1 To lieshu)
For i = 1 To lieshu1
C(i) = 0
Next i
For i = lieshu1 + 1 To lieshu
C(i) = -1
Next i
For i = 1 To hangshu
For j = 1 To lieshu
C(j) = C(j) + A(i, j)
Next j
Next i



'给fvalue赋初值:
fvalue = 0
For i = 1 To hangshu
fvalue = fvalue + B(i)
Next i

 '给向量jx()赋初值:

ReDim JX(1 To hangshu)
For i = 1 To hangshu
JX(i) = 3 * N + i
Next i


Call AJmax(C(), lieshu)
If Cmax > 0 Then
10: Call AImin(A(), B(), hangshu)
Call xiaoyuan(A(), B(), C(), Jmax, Imin, fvalue, lieshu, hangshu)
JX(Imin) = Jmax
End If
Call AJmax(C(), lieshu)
If Cmax > 0 Then GoTo 10
If fvalue = 0 Then

For izy = 1 To hangshu
If (JX(izy) > 3 * N) Then
jzy = 1
Do While (A(izy, jzy) = 0)
jzy = jzy + 1
Loop
Azuyuan = A(izy, jzy)

If (izy = 1) Then

For i = 2 To hangshu
If A(i, jzy) <> 0 Then
Q = A(i, jzy)
For j = 1 To lieshu
A(i, j) = A(i, j) - Q * A(izy, j) / Azuyuan
Next j
End If
Next i
ElseIf izy = hangshu Then

For i = 1 To hangshu - 1
If A(i, jzy) <> 0 Then
Q = A(i, Jmax)
For j = 1 To lieshu
A(i, j) = A(i, j) - Q * A(izy, j) / Azuyuan
Next j
End If
Next i

Else

For i = 1 To izy - 1
If A(i, jzy) <> 0 Then
Q = A(i, jzy)
For j = 1 To lieshu
A(i, j) = A(i, j) - Q * A(izy, j) / Azuyuan
Next j
End If
Next i
For i = izy + 1 To hangshu
If A(i, jzy) <> 0 Then
Q = A(i, jzy)
For j = 1 To lieshu
A(i, j) = A(i, j) - Q * A(izy, j) / Azuyuan
Next j
End If
Next i
End If
JX(izy) = jzy
End If
Next izy

'第二阶段
'给A2赋初值:
ReDim A2(1 To hangshu, 1 To lieshu1)

For i = 1 To hangshu
For j = 1 To lieshu1
A2(i, j) = A(i, j)
Next j
Next i
'给C2赋初值:
ReDim C2(1 To lieshu1)
ReDim C3(1 To lieshu1)
For i = 1 To N
C3(i) = P(i)
Next i
For i = 1 To lieshu1
C2(i) = -C3(i)
Next i
fvalue2 = 0
For i = 1 To hangshu
If C3(JX(i)) <> 0 Then
For k = 1 To lieshu1
C2(k) = C2(k) + A(i, k) * C3(JX(i))
Next k
fvalue2 = fvalue2 + B(i) * C3(JX(i))
End If
Next i

Call AJmax(C2(), lieshu1)
If Cmax > 0 Then

20: Call AImin(A2(), B(), hangshu)
Call xiaoyuan(A2(), B(), C2(), Jmax, Imin, fvalue2, lieshu1, hangshu)
JX(Imin) = Jmax
End If
Call AJmax(C2(), lieshu1)
If Cmax > 0 Then GoTo 20

Else
fvalue2 = 0
End If

End Sub


'寻找数组元素中的最大值(寻找主元素的列标)
Sub AJmax(C() As Double, num)
Dim i As Integer
Cmax = C(1)
Jmax = 1
For i = 1 To num
If C(i) > Cmax Then
Cmax = C(i)
Jmax = i
End If
Next i
End Sub

'寻找主元素的行标
Sub AImin(A() As Double, B() As Double, num)
Dim AIJ(1 To 25) As Double
Dim min As Double
Dim i As Integer
Dim j As Integer
For i = 1 To num
If (A(i, Jmax) > 0) Then
AIJ(i) = B(i) / A(i, Jmax)
End If
If (0 >= A(i, Jmax)) Then
AIJ(i) = 100000
End If
Next i
min = 100000
Imin = 1
For i = 1 To num
If (AIJ(i) < min) Then
min = AIJ(i)
Imin = i
End If
Next i
End Sub

'消元子程序:
Sub xiaoyuan(A() As Double, B() As Double, C() As Double, Jmax, Imin, fvalue, numlie As Integer, numhang As Integer)
Dim BImin As Double
Dim CJmax As Double
Dim Azy As Double
Dim m As Double
Dim N As Double
Dim i As Integer
Dim j As Integer

BImin = B(Imin)
CJmax = C(Jmax)
Azy = A(Imin, Jmax)

If Imin = 1 Then

For i = 2 To numhang
If A(i, Jmax) <> 0 Then
B(i) = B(i) - BImin * A(i, Jmax) / Azy
m = A(i, Jmax)
For j = 1 To numlie
A(i, j) = A(i, j) - m * A(Imin, j) / Azy
Next j
End If
Next i
For j = 1 To numlie
C(j) = C(j) - CJmax * A(Imin, j) / Azy
Next j
fvalue = fvalue - CJmax * BImin / Azy

ElseIf Imin = numhang Then

For i = 1 To numhang - 1
If A(i, Jmax) <> 0 Then
B(i) = B(i) - BImin * A(i, Jmax) / Azy
m = A(i, Jmax)
For j = 1 To numlie
A(i, j) = A(i, j) - m * A(Imin, j) / Azy
Next j
End If
Next i
For j = 1 To numlie
C(j) = C(j) - CJmax * A(Imin, j) / Azy
Next j
fvalue = fvalue - CJmax * BImin / Azy
Else

For i = 1 To Imin - 1
If A(i, Jmax) <> 0 Then
B(i) = B(i) - BImin * A(i, Jmax) / Azy

m = A(i, Jmax)
For j = 1 To numlie
A(i, j) = A(i, j) - m * A(Imin, j) / Azy
Next j
End If
Next i
For j = 1 To numlie
C(j) = C(j) - CJmax * A(Imin, j) / Azy
Next j
For i = Imin + 1 To numhang
If A(i, Jmax) <> 0 Then
B(i) = B(i) - BImin * A(i, Jmax) / Azy

m = A(i, Jmax)
For j = 1 To numlie
A(i, j) = A(i, j) - m * A(Imin, j) / Azy
Next j
End If
Next i
fvalue = fvalue - CJmax * BImin / Azy
End If
End Sub