Option Base 1 
'全部存儲(chǔ) 
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 '循環(huán)變量 
  Dim j As Integer '循環(huán)變量 
  Dim k As Integer '循環(huán)變量 
  Dim D_Temp As Double '雙精度型臨時(shí)變量 
  Dim I_Temp As Integer '整型臨時(shí)變量 
  ReDim result(N) As Double '結(jié)果數(shù)組 
  ReDim sort(N) As Integer 
  For i = 1 To N 
    sort(i) = i 
  Next 
  'dim 
  '消元 
  For i = 1 To N - 1 
    '判斷當(dāng)前消元主系數(shù)是否為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個(gè)元素仍為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 
  '根據(jù)行交換記錄，轉(zhuǎn)換結(jié)果 
  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 
'對(duì)稱正定矩陣，下三角存儲(chǔ),未使用該子程序 
Public Function Goss2(Matrix_Left() As Double, Matrix_Right() As Double, result() As Double) As String 
  Dim N As Integer 
  '方程維數(shù) 
  N = UBound(Matrix_Right) 
  '檢查方程是否合法 
  If UBound(Matrix_Left) <> (N + 1) * N / 2 Then GoTo Exception1 
  Dim i As Integer '循環(huán)變量 
  Dim j As Integer '循環(huán)變量 
  Dim k As Integer '循環(huán)變量 
  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 
'等帶寬存儲(chǔ)，存儲(chǔ)上三角半帶寬部分，未使用該子程序 
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 '循環(huán)變量 
  Dim j As Integer '循環(huán)變量 
  Dim k As Integer '循環(huán)變量 
  Dim KF As Integer '修改行號(hào)上限 
  'Dim KK As Integer '一行中修改列號(hào)上限 
  ReDim result(N) As Double '結(jié)果數(shù)組 
  '消元 
  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