Manupilation des matrices

Commenter

Contenu du snippet

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

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (azizimoh)