Private Const errNONSOL1 As Integer = -1
Private Const errNONSOL2 As Integer = -2
Option Explicit
Public Sub MATRICE_Gauss(ByVal N As Integer, _
ByRef TA() As Double, _
ByRef TB() As Double, _
ByRef TX() As Double, _
ByRef err As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim w As Double
For k = 1 To N - 1
m = k
w = TA(k, k)
For i = k + 1 To N
If Abs(w) < Abs(TA(i, k)) Then
m = i
w = TA(i, k)
End If
Next i
If (m <> k) Then
For i = 1 To N
TX(i) = TA(k, i)
TA(k, i) = TA(m, i)
TA(m, i) = TX(i)
Next i
w = TB(k)
TB(k) = TB(m)
TB(m) = w
End If
If TA(k, k) = 0 Then err = errNONSOL1: Exit Sub
For i = k + 1 To N
w = TA(i, k) / TA(k, k)
For j = 1 To N
If (j < k) Then
TA(i, j) = 0
Else
TA(i, j) = TA(i, j) - w * TA(k, j)
End If
Next j
TB(i) = TB(i) - w * TB(k)
Next i
Next k
Call MAT_sup(N, TA(), TB(), TX(), err)
End Sub
Public Sub MATRICE_Crout(ByVal N As Integer, _
ByRef TA() As Double, _
ByRef TB() As Double, _
ByRef TX() As Double, _
ByRef err As Integer)
Dim w As Double
Dim r As Integer
Dim i As Integer
Dim k As Integer
Dim Tu() As Double
Dim Tl() As Double
ReDim Tu(N, N), Tl(N, N)
For i = 1 To N
Tu(i, i) = 1
Tl(i, 1) = TA(i, 1)
If Tl(1, 1) = 0 Then err = errNONSOL1: Exit Sub
Tu(1, i) = TA(1, i) / Tl(1, 1)
Next i
For r = 2 To N
For i = r To N
w = 0
For k = 1 To r - 1
w = w + Tl(i, k) * Tu(k, r)
Next k
Tl(i, r) = TA(i, r) - w
Next i
For i = r + 1 To N
w = 0
For k = 1 To r - 1
w = w + Tl(r, k) * Tu(k, i)
Next k
If Tl(r, r) = 0 Then err = errNONSOL1: Exit Sub
Tu(r, i) = (TA(r, i) - w) / Tl(r, r)
Next i
Next r
Call MAT_inf(N, Tl(), TB(), TX(), err)
For i = 1 To N
TB(i) = TX(i)
Next i
Call MAT_sup(N, Tu(), TB(), TX(), err)
End Sub
Public Sub MATRICE_Thomas(ByVal N As Integer, _
ByRef v1() As Double, _
ByRef v2() As Double, _
ByRef v3() As Double, _
ByRef TB() As Double, _
ByRef TX() As Double, _
ByRef err As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim w As Double
v1(1) = v1(1) / v2(1)
TB(1) = TB(1) / v2(1)
For i = 2 To N
w = v2(i) - v3(i) * v1(i - 1)
If w = 0 Then err = -1: Exit Sub
v1(i) = v1(i) / w
TB(i) = (TB(i) - v3(i) * TB(i - 1)) / w
Next i
TX(N) = TB(N)
For i = N - 1 To 1 Step (-1)
TX(i) = TB(i) - v1(i) * TX(i + 1)
Next i
End Sub
Public Sub MATRICE_Chebycheve(ByVal a As Double, _
ByVal b As Double, _
ByVal NPTS As Integer, _
ByRef TX() As Double, _
ByRef err As Integer)
Dim k As Integer
For k = 1 To NPTS
TX(k) = (a + b) / 2 + ((b - a) / 2) * Cos((3.14159265 / NPTS) * (k - 1 / 2))
Next k
End Sub
Public Sub MAT_sup(ByVal N As Integer, _
ByRef TA() As Double, _
ByRef TB() As Double, _
ByRef TX() As Double, _
ByRef err As Integer)
Dim i As Integer
Dim j As Integer
Dim w As Double
For i = 1 To N
If TA(i, i) = 0 Then err = errNONSOL2: Exit Sub
Next i
TX(N) = TB(N) / TA(N, N)
For i = N - 1 To 1 Step (-1)
w = 0
For j = i + 1 To N
w = w + TA(i, j) * TX(j)
Next j
TX(i) = (TB(i) - w) / TA(i, i)
Next i
End Sub
Public Sub MAT_inf(ByVal N As Integer, _
ByRef TA() As Double, _
ByRef TB() As Double, _
ByRef TX() As Double, _
ByRef err As Integer)
Dim i As Integer
Dim j As Integer
Dim w As Double
For i = 1 To N
If TA(i, i) = 0 Then err = errNONSOL2: Exit Sub
Next i
TX(1) = TB(1) / TA(1, 1)
For i = 1 To N
w = 0
For j = 1 To i - 1
w = w + TA(i, j) * TX(j)
Next j
TX(i) = (TB(i) - w) / TA(i, i)
Next i
End Sub