module1.bas

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

Attribute VB_Name = "Module1"
Option Explicit

Public Q(1 To 8, 1 To 4) As Double
Public I As Integer
Public J As Integer
Public Z(1 To 8, 1 To 5) As Double
Public t As Double
Public k As Double
Public Jmax As Integer
Public Imin As Integer
Public Cmax As Double

'临时数据
Public A() As Double
Public A2() As Double
Public C() As Double
Public C2() As Double
Public B() As Double
Public P() As Double
Public JX() As Double
Public fvalue As Double
Public fvalue2 As Double


'煤耗曲线线性化子程序
 Sub linear(A As Double, B As Double, C As Double, xmin As Double, xmax As Double)
 Dim ymin As Double
 Dim ymax As Double
 
 ymin = A * xmin * xmin + B * xmin + C
 ymax = A * xmax * xmax + B * xmax + C
 t = (ymax - ymin) / (xmax - xmin)
 k = (ymin * xmax - ymax * xmin) / (xmax - xmin)
 
 End Sub
Sub good(N As Integer, P() As Double, B() As Double)

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

ReDim A(1 To N + 1, 1 To 3 * N + 1)
For I = 1 To N
A(1, I) = 1
Next I
For I = 2 To hangshu
A(I, I - 1) = 1: A(I, I + N - 1) = 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赋初值:
For I = 1 To hangshu
fvalue = fvalue + B(I)
Next I

 '给向量jx()赋初值:

ReDim JX(1 To hangshu)
For I = 1 To hangshu
JX(I) = 2 * 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
Open "E:\wyl\临时文件.txt" For Append As #2
For I = 1 To hangshu
Print #2, B(I);
Next I
Print #2,
For I = 1 To hangshu
Print #2, JX(I);
Next I
Print #2, fvalue
Print #2,
For I = 1 To lieshu
Print #2, C(I);
Next I
Close #2

'第二阶段
'给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)
For I = 1 To N
C2(I) = -P(I)
Next I
For I = 1 To N
For J = 1 To hangshu
If A2(J, I) = 1 Then
For k = 1 To lieshu1
C2(k) = C2(k) + A(J, k) * P(I)
Next k
End If
Next J
Next I

'给fvalue2赋初值:

For I = 1 To N
For J = 1 To hangshu
If A2(J, I) = 1 Then
fvalue2 = fvalue2 + B(J) * P(I)
End If
Next J
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(), hangshu)
If Cmax > 0 Then GoTo 20
Open "E:\wyl\临时文件.txt" For Append As #2
For I = 1 To hangshu
Print #2, B(I);
Next I
Print #2,
For I = 1 To hangshu
Print #2, JX(I);
Next I
Print #2, fvalue2
Print #2,
For I = 1 To lieshu1
Print #2, C2(I);
Next I

Close #2
End Sub


'寻找数组元素中的最大值(寻找主元素的列标)
Sub AJmax(C() As Double, num)
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 4) As Double
Dim min As Double
For I = 1 To num
If (A(I, Jmax) > 0) Then
AIJ(I) = B(I) / A(I, Jmax)
End If
Next I
min = 100
Imin = 1
For I = 1 To num
If (AIJ(I) < min) And (AIJ(I) > 0) 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

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