Colaboraci�n de Harvey Triana (2)

Rutina para la Soluci�n de Ecuaciones Lineales

Lo que nos dice el autor sobre esta rutina:

Soluci�n de Ecuaciones Lineales
======================
La soluci�n de un sistema de 'n' ecuaciones lineales con 'n' inc�gnitas es un interesante reto a los programadores.
El siguiente c�digo lo escrib� inicialmente en Fortran, aqu� te presento la versi�n Visual Basic.
He utilizado esta funci�n en programaci�n de Simuladores de Flujo y Soluci�n del M�todo de los M�nimos Cuadrados.
En general, la funci�n tiene m�ltiples usos en procedimientos matem�ticos.

Es un c�digo bastante complicado de seguir, pero si necesitas una gu�a, es el m�todo de Eliminaci�n de Gauss.

'Esto acelerar� los c�lculos
DefInt A-Z

Private Sub EjemploSencillo()
   
   'Se tiene el siguiente sistema de ecuaciones lineales que debe ser resuelto:
   '|1 1 1 6|
   '|1 0 1 4|
   '|1 1 0 3|

    Dim Sistema(1 To 3, 1 To 4) As Double 'Almacenar� el sistema de ecuaciones
    Dim Soluci�n(1 To 3) As Double        'Almacenar� la soluci�n del sistema
    
    Sistema(1, 1) = 1: Sistema(1, 2) = 1: Sistema(1, 3) = 1: Sistema(1, 4) = 6
    Sistema(2, 1) = 1: Sistema(2, 2) = 0: Sistema(2, 3) = 1: Sistema(2, 4) = 4
    Sistema(3, 1) = 1: Sistema(3, 2) = 1: Sistema(3, 3) = 0: Sistema(3, 4) = 3
    
    If Gauss(Sistema(), Soluci�n()) Then
       Debug.Print "Soluci�n:"
       Debug.Print "C1 = "; Soluci�n(1)
       Debug.Print "C2 = "; Soluci�n(2)
       Debug.Print "C3 = "; Soluci�n(3)
       Stop
    Else
       MsgBox "El sistema de ecuaciones no tiene soluci�n..."
    End If
End Sub


'-------------------------------------------------------------------------
'Matrix Solution. Return True if then function was successful
'-------------------------------------------------------------------------
Static Function Gauss(ByRef A() As Double, ByRef C() As Double) As Boolean
   
    Dim Tem As Double, Sum As Double, i, l, j, k, n, m
    
    On Error GoTo Gauss_Err
    n = UBound(C)
    m = n + 1
    For l = 1 To n - 1
        j = l
        For k = l + 1 To n
            If (Abs(A(j, l)) < Abs(A(k, l))) Then j = k
        Next
        If Not (j = l) Then
           For i = 1 To m
               Tem = A(l, i)
               A(l, i) = A(j, i)
               A(j, i) = Tem
           Next
        End If
        For j = l + 1 To n
            Tem = A(j, l) / A(l, l)
            For i = 1 To m
                A(j, i) = A(j, i) - Tem * A(l, i)
            Next
        Next
    Next
    C(n) = A(n, m) / A(n, n)
    For i = 1 To n - 1
        j = n - i
        Sum = 0
        For l = 1 To i
            k = j + l
            Sum = Sum + A(j, k) * C(k)
        Next
        C(j) = (A(j, m) - Sum) / A(j, j)
    Next
    Gauss = True
    
   'Programmed by Harvey Triana �
    Exit Function
    
Gauss_Err: Gauss = False
End Function