LinkBack URL
About LinkBacks
I'm trying to write a code to do Gaussian Elimination with partial pivoting. Basically it is a way to solve for a system of equations using matrices. I have written it to locate the cells in the spreadsheet for the coefficient matrix and also for the constant variables. The first step is to find the largest value in the first column and then make the row with that value become the first row. if it was in row 2, row 1 becomes row 2 and row 2 becomes row 1 etc. Next is to make row2 column1 zero and row 3 column 1 zero by using the value in row 1 column1 to make the transformation. This cycle repeats until you end up with an upper triangular matrix. All values below the diagonal are zero such that finding the value of the unknown for row 3 column 3 is determined by taking the constant variable divided by the coefficient in row 3 column 3 and then using back substitution to determine the values of the other unknowns. The following is the code that I have come up with. I tried working it out on paper and it worked out but it doesn't seem to work when I try running it on the spreadsheet. Would you mind looking to see where I am messing up? Thank you in advance.
Function GaussPartialPivot(n)
'Defining Arrays to use and thier size with (row, column)
Dim a()
Dim ans() As Double
Dim b()
Dim PivotLogical() As Boolean
Dim PivotRow() As Integer
Dim TempMax As Double
Dim temp As Double
Dim tempb As Double
Dim NormFactor As Double
Dim ElimFactor As Double
ReDim Preserve a(1 To n, 1 To n)
ReDim Preserve ans(1 To n)
ReDim Preserve b(1 To n)
'reading values of a and b from sheet
Sheets("GaussPartialPivot").Select
For i = 1 To n
For j = 1 To n
If j < n + 1 Then
a(i, j) = Cells(i + 8, 2 * j + 2)
Else
b(i) = Cells(i + 8, 2 * j + 2)
End If
Next j
Next i
For j = 1 To n + 1
PivotLogical(j) = False: Next
'Find maximum value in column
For c = 1 To n
TempMax = 0
For r = c To n
If Abs(a(r, c)) <= TempMax Then GoTo LoopEnd
If PivotLogical(r) = True Then GoTo LoopEnd
PivotRow(c) = r
TempMax = Abs(a(r, c))
LoopEnd: Next r
If TempMax < 1E-100 Then
GaussPartialPivot = CVErr(xlErrDiv0)
Exit Function
End If
P = PivotRow(c)
PivotLogical(P) = True
'Switch MaxRow with uppermost row
For j = 1 To n + 1
For i = 2 To n - 1
If j < n + 1 And p > 1 And p < n Then
temp = a(p - 1, j)
a(p - 1, j) = a(p, j)
a(p, j) = temp
a(p, j) = a(p - 1, j)
ElseIf j = n + 1 And p > 1 And p < n Then
tempb = b(p - 1)
b(p - 1) = b(p)
b(p) = tempb
'b(p) = b(p - 1)
'ElseIf j < n + 1 And p = n Then
'temp = a(i, j)
'a(i, j) = a(i + 1, j)
'a(i + 1, j) = temp
'a(p, j) = a(p - 2, j)
'Else
'tempb = b(p - 1)
'b(p - 1) = b(p)
'b(p) = tempb
'b(p) = b(p - 2)
'End If
'Next i
'Next j
NormFactor = a(c, c)
If NormFactor = 0 Then
For j = c To n
temp = a(c, j)
a(c, j) = a(c + 1, j)
a(c + 1, j) = temp
Next j
NormFactor = a(c, c)
End If
For j = c To n
a(c, j) = a(c, j) / NormFactor
Next j
b(c) = b(c) / NormFactor
For r = c + 1 To n
ElimFactor = a(r, c)
For j = c To n
a(r, j) = a(r, j) - a(c, j) * ElimFactor
Next j
b(r) = b(r) - b(c) * ElimFactor
Next r
Next c
ans(n) = b(n) / a(n, n)
For i = n - 1 To 1 Step -1
Sum = b(i)
For j = i + 1 To n
Sum = Sum - a(i, j) * ans(j)
Next j
ans(i) = Sum / a(i, i)
Next i
'For k = n To 1 Step -1
'ans(k) = b(n)
'For k = 1 To n - 1
'For i = k + 1 To n
'factor = a(i, k) / a(k, k)
'For j = k + 1 To n
'a(i, j) = a(i, j) - factor * a(k, j)
'Next j
'b(i) = b(i) - factor * b(k)
'Next i
'Next k
'Sum = 0
'ans(n) = b(n) / a(n, n)
'For i = n - 1 To 1 Step -1
'Sum = b(i)
'term = 0
'For c = n To k Step -1
'term = term + a(k, c) * ans(c)
'Next c
'ans(k) = a(k, n) - term
'Next k
'For j = i + 1 To n
'Sum = Sum - a(i, j) * ans(j)
'Next j
'ans(i) = Sum / a(i, i)
'Next i
If Application.Caller.Rows.Count > 1 Then
GaussPartialPivot = Application.Transpose(ans)
Else
GaussPartialPivot = ans
End If
End Function
Register To Reply
Re: VBA Program for Gaussian Elimination with Partial Pivoting?
Bookmarks