goss.txt

用GOSS解线性方程组 Dim i As Integer 循环变量 Dim j As Integer 循环变量 Dim k As Integer 循环变量

Option Base 1 
'全部存储 
Public Function Goss1(Matrix_Left() As Double, Matrix_Right() As Double, result() As Double) As String 
  Dim N As Integer 
   
  N = UBound(Matrix_Right) 
   
  If UBound(Matrix_Left, 1) <> UBound(Matrix_Left, 2) Then GoTo Exception1 
  If UBound(Matrix_Left, 1) <> N Then GoTo Exception2 
   
  Dim i As Integer '循环变量 
  Dim j As Integer '循环变量 
  Dim k As Integer '循环变量 
  Dim D_Temp As Double '双精度型临时变量 
  Dim I_Temp As Integer '整型临时变量 
  ReDim result(N) As Double '结果数组 
  ReDim sort(N) As Integer 
  For i = 1 To N 
    sort(i) = i 
  Next 
  'dim 
  '消元 
  For i = 1 To N - 1 
    '判断当前消元主系数是否为0，如是则交换行 
    If Matrix_Left(i, i) = 0 Then 
      For j = i + 1 To N 
        '交换行 
        If Matrix_Left(j, i) <> 0 Then 
          For k = i To N 
            D_Temp = Matrix_Left(j, k) 
            Matrix_Left(j, k) = Matrix_Left(i, k) 
            Matrix_Left(i, k) = D_Temp 
          Next 
          D_Temp = Matrix_Right(i) '交换方程右端 
          Matrix_Right(i) = Matrix_Right(j) 
          Matrix_Right(j) = D_Temp 
          I_Temp = sort(i) '记录交换 
          sort(i) = sort(j) 
          sort(j) = I_Temp 
          Exit For 
        Else 
          If j = N Then GoTo Exception3 '如果第n个元素仍为0则方程无解 
        End If 
      Next 
    End If 
okok.org 
    '第i次消元 
    For j = i + 1 To N 
      D_Temp = Matrix_Left(j, i) / Matrix_Left(i, i) 
      'Matrix_Left(j, i) = 0 
      For k = i + 1 To N 
        Matrix_Left(j, k) = Matrix_Left(j, k) - Matrix_Left(i, k) * D_Temp 
      Next 
      Matrix_Right(j) = Matrix_Right(j) - Matrix_Right(i) * D_Temp 
    Next 
  Next 
  '消元后，最后一行元素为0，则方程无解 
  If Matrix_Left(N, N) = 0 Then GoTo Exception3 
  '回代 
  For i = N To 1 Step -1 
    For j = i + 1 To N 
      Matrix_Right(i) = Matrix_Right(i) - Matrix_Left(i, j) * result(j) 
    Next j 
    result(i) = Matrix_Right(i) / Matrix_Left(i, i) 
  Next 
  '根据行交换记录，转换结果 
  For i = 1 To N 
    While i <> sort(i) 
      I_Temp = sort(sort(i)) 
      D_Temp = result(sort(i)) 
      sort(sort(i)) = sort(i) 
      result(sort(i)) = result(i) 
      sort(i) = I_Temp 
      result(i) = D_Temp 
    Wend 
  Next i 
  Goss1 = "Success" 
  Exit Function 
Exception1: 
  Goss1 = "Error1" 
  Exit Function 
Exception2: 
  Goss1 = "Error2" 
  Exit Function 
Exception3: 
  Goss1 = "Error3" 
  Exit Function 
End Function 
'对称正定矩阵，下三角存储,未使用该子程序 
Public Function Goss2(Matrix_Left() As Double, Matrix_Right() As Double, result() As Double) As String 
  Dim N As Integer 
  '方程维数 
  N = UBound(Matrix_Right) 
  '检查方程是否合法 
  If UBound(Matrix_Left) <> (N + 1) * N / 2 Then GoTo Exception1 
  Dim i As Integer '循环变量 
  Dim j As Integer '循环变量 
  Dim k As Integer '循环变量 
  ReDim result(N) As Double 
  '消元 
  For i = 1 To N - 1 
    For j = i + 1 To N 
      For k = i + 1 To j 
        Matrix_Left((j - 1) * j / 2 + k) = Matrix_Left((j - 1) * j / 2 + k) - Matrix_Left((k - 1) * k / 2 + i) * Matrix_Left((j - 1) * j / 2 + i) / Matrix_Left((i + 1) * i / 2) 
      Next 
      Matrix_Right(j) = Matrix_Right(j) - Matrix_Right(i) * Matrix_Left((j - 1) * j / 2 + i) / Matrix_Left((i + 1) * i / 2) 
    Next j 
  Next 
  '回代 
  For i = N To 1 Step -1 
    For j = i + 1 To N 
      Matrix_Right(i) = Matrix_Right(i) - Matrix_Left((j - 1) * j / 2 + i) * result(j) 
    Next j 
    result(i) = Matrix_Right(i) / Matrix_Left((i + 1) * i / 2) 
  Next 
  Goss = "Success" 
  Exit Function 
Exception1: 
  Goss2 = "Error1" 
  Exit Function 
End Function 
'等带宽存储，存储上三角半带宽部分，未使用该子程序 
Public Function Goss3(Matrix_Left() As Double, Matrix_Right() As Double, result() As Double) As String 
  Dim UBW As Integer 
  Dim N As Integer 
  N = UBound(Matrix_Right) 
  UBW = UBound(Matrix_Left, 2) 
  If UBound(Matrix_Left, 1) <> N Then GoTo Exception1 
  Dim i As Integer '循环变量 
  Dim j As Integer '循环变量 
  Dim k As Integer '循环变量 
  Dim KF As Integer '修改行号上限 
  'Dim KK As Integer '一行中修改列号上限 
  ReDim result(N) As Double '结果数组 
  '消元 
  For i = 1 To N - 1 
    KF = i + UBW - 1 
    If KF > N Then KF = N 
    For j = i + 1 To KF 
      For k = j To KF 
        Matrix_Left(j, k - j + 1) = Matrix_Left(j, k - j + 1) - Matrix_Left(i, k - i + 1) * Matrix_Left(i, j - i + 1) / Matrix_Left(i, 1) 
      Next 
      Matrix_Right(j) = Matrix_Right(j) - Matrix_Right(i) * Matrix_Left(i, j - i + 1) / Matrix_Left(i, 1) 
    Next 
  Next 
  '回代 
  For i = N To 1 Step -1 
    KF = i + UBW - 1 
    If KF > N Then KF = N 
    For j = i + 1 To KF 
      Matrix_Right(i) = Matrix_Right(i) - result(j) * Matrix_Left(i, j - i + 1) 
    Next 
    result(i) = Matrix_Right(i) / Matrix_Left(i, 1) 
  Next 
  Goss3 = "Success" 
  Exit Function 
Exception1: 
  Goss3 = "Error1" 
  Exit Function 
End Function