form1.frm

共轭梯度法解决线性方程组,系数满足对称正定矩阵

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3075
   ClientLeft      =   60
   ClientTop       =   465
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3075
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   1215
      Left            =   1080
      TabIndex        =   0
      Top             =   600
      Width           =   4095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Command1_Click()






Call CGmethod

End Sub
 Sub CGmethod()   'ByVal n As Long共轭梯度法解线性方程组(满足对称正定矩阵条件)
 Dim n As Long
 Dim StrLine As String
 Dim varline As Variant
 '循环变量
Dim i, j, k As Integer
 Open App.Path & "\A.dat" For Input As #1
 Line Input #1, StrLine
 varline = Split(StrLine, " ")
 n = UBound(varline)
 '赋值变量
ReDim A(0 To n - 1, 0 To n - 1) As Double
ReDim B(0 To n - 1) As Double
'求解变量
ReDim X(0 To n - 1)
For i = 0 To n - 1
   X(i) = 0
Next i
 For j = 0 To n - 1
   A(0, j) = CDbl(varline(j))
 Next j
 B(0) = CDbl(varline(n))
 i = 1
 Do While Not EOF(1)
   Line Input #1, StrLine
   varline = Split(StrLine, " ")
   For j = 0 To n - 1
      A(i, j) = CDbl(varline(j))
   Next j
  B(i) = CDbl(varline(n))
 i = i + 1
 Loop
 Close #1

'计算变量
Dim v As Double
Dim q As Double
Dim e As Double
Dim rd As Double
Dim dad As Double
Dim rad As Double

ReDim AA(0 To n - 1) As Double
ReDim ad(0 To n - 1) As Double
ReDim r(0 To n - 1), d(0 To n - 1), p(0 To n - 1) As Double 'r为残差适量d为搜索方向矢量p为矢量

e = 1
k = 0
  For i = 0 To n - 1
       AA(i) = 0
    For j = 0 To n - 1
       AA(i) = AA(i) + A(i, j) * X(j)
    Next j
   r(i) = B(i) - AA(i)
   d(i) = r(i)
  Next i
  rd = 0
  For i = 0 To n - 1 '求内积V=r,d
     rd = rd + r(i) * d(i)
  Next i
  
  For i = 0 To n - 1 '求AD
      ad(i) = 0
      For j = 0 To n - 1
      ad(i) = ad(i) + A(i, j) * d(j)
      Next j
  Next i
 dad = 0
 For i = 0 To n - 1
    dad = dad + d(i) * ad(i)
 Next i
 v = rd / dad
 For i = 0 To n - 1
    X(i) = X(i) + v * d(i)
 Next i

k = 1
Do While e > 0.0001
For i = 0 To n - 1
       AA(i) = 0
    For j = 0 To n - 1
       AA(i) = AA(i) + A(i, j) * X(j)
    Next j
   r(i) = B(i) - AA(i)
   
  Next i
  'Q=-(r,ad)/(d,ad)
  '
  rad = 0
  For i = 0 To n - 1 'r,ad
      rad = rad + r(i) * ad(i)
  Next
  
  q = -rad / dad
  
  'd
  For i = 0 To n - 1
     d(i) = r(i) + q * d(i)
  Next i
  
  rd = 0
  For i = 0 To n - 1 '求内积V=r,d
     rd = rd + r(i) * d(i)
  Next i
  
  For i = 0 To n - 1 '求AD
      ad(i) = 0
      For j = 0 To n - 1
      ad(i) = ad(i) + A(i, j) * d(j)
      Next j
  Next i
 dad = 0
 For i = 0 To n - 1
    dad = dad + d(i) * ad(i)
 Next i
 v = rd / dad
 For i = 0 To n - 1
    X(i) = X(i) + v * d(i)
 Next i
 e = 0
For i = 0 To n - 1
e = e + r(i) ^ 2
Next i
e = Sqr(e)
k = k + 1
Loop
MsgBox k
For i = 0 To n - 1
MsgBox "x" & i & "=" & X(i)
Next i
End Sub