qrdcmp.txt

来自「VB常用数值算法集 内含有解线性代数方程组」· 文本 代码 · 共 48 行

Sub QRDCMP(A(), M, N, Q())
    For I = 1 To M
        For J = 1 To M
            Q(I, J) = 0#
        Next J
        Q(I, I) = 1#
    Next I
    For K = 1 To M - 1
        S = 0#
        For I = K To M
            S = S + Abs(A(I, K))
        Next I
        If S <> 0# Then
            T = 0#
            For I = K To M
                A(I, K) = A(I, K) / S
                T = T + A(I, K) * A(I, K)
            Next I
            T = -Sqr(T) * Sgn(A(K, K))
            A(K, K) = A(K, K) - T
            H = -T * A(K, K)
            For J = K + 1 To N
                F = 0#
                For I = K To M
                    F = F + A(I, K) * A(I, J)
                Next I
                F = F / H
                For I = K To M
                    A(I, J) = A(I, J) - A(I, K) * F
                Next I
            Next J
            For J = 1 To M
                F = 0#
                For I = K To M
                    F = F + A(I, K) * Q(I, J)
                Next I
                F = F / H
                For I = K To M
                    Q(I, J) = Q(I, J) - A(I, K) * F
                Next I
            Next J
            A(K, K) = T * S
            For I = K + 1 To M
                A(I, K) = 0#
            Next I
        End If
    Next K
End Sub