solvde.txt

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

Sub SOLVDE(ITMAX, CONV, SLOWC, SCALV(), INDEXV(), NE, NB, M, Y(), NYJ, NYK, C(), NCI, NCJ, NCK, S(), NSI, NSJ)
    Dim ERMAX(10), KMAX(10)
    K1 = 1
    K2 = M
    NVARS = NE * M
    J1 = 1
    J2 = NB
    J3 = NB + 1
    J4 = NE
    J5 = J4 + J1
    J6 = J4 + J2
    J7 = J4 + J3
    J8 = J4 + J4
    J9 = J8 + J1
    IC1 = 1
    IC2 = NE - NB
    IC3 = IC2 + 1
    IC4 = NE
    JC1 = 1
    JCF = IC3
    For IT = 1 To ITMAX
        K = K1
        Call DIFEQ(K, K1, K2, J9, IC3, IC4, INDEXV(), NE, S(), NSI, NSJ, Y(), NYJ, NYK)
        Call PINVS(IC3, IC4, J5, J9, JC1, K1, C(), NCI, NCJ, NCK, S(), NSI, NSJ)
        For K = K1 + 1 To K2
            KP = K - 1
            Call DIFEQ(K, K1, K2, J9, IC1, IC4, INDEXV(), NE, S(), NSI, NSJ, Y(), NYJ, NYK)
            Call RED(IC1, IC4, J1, J2, J3, J4, J9, IC3, JC1, JCF, KP, C(), NCI, NCJ, NCK, S(), NSI, NSJ)
            Call PINVS(IC1, IC4, J3, J9, JC1, K, C(), NCI, NCJ, NCK, S(), NSI, NSJ)
        Next K
        K = K2 + 1
        Call DIFEQ(K, K1, K2, J9, IC1, IC2, INDEXV(), NE, S(), NSI, NSJ, Y(), NYJ, NYK)
        Call RED(IC1, IC2, J5, J6, J7, J8, J9, IC3, JC1, JCF, K2, C(), NCI, NCJ, NCK, S(), NSI, NSJ)
        Call PINVS(IC1, IC2, J7, J9, JCF, K2 + 1, C(), NCI, NCJ, NCK, S(), NSI, NSJ)
        Call BKSUB(NE, NB, JCF, K1, K2, C(), NCI, NCJ, NCK)
        ERQ = 0#
        For J = 1 To NE
            JV = INDEXV(J)
            ERMAX(J) = 0#
            ERRJ = 0#
            KMAX(J) = 0
            VMAX = 0#
            For K = K1 To K2
                VZ = Abs(C(J, 1, K))
                If VZ > VMAX Then
                    VMAX = VZ
                    KM = K
                End If
                ERRJ = ERRJ + VZ
            Next K
            ERQ = ERQ + ERRJ / SCALV(JV)
            ERMAX(J) = C(J, 1, KM) / SCALV(JV)
            KMAX(J) = KM
        Next J
        ERQ = ERQ / NVARS
        If ERQ > SLOWC Then
            DUM = ERQ
        Else
            DUM = SLOWC
        End If
        FAC = SLOWC / DUM
        For JV = 1 To NE
            J = INDEXV(JV)
            For K = K1 To K2
                Y(J, K) = Y(J, K) - FAC * C(JV, 1, K)
            Next K
        Next JV
        Print Tab(3); Format$(IT, "####"); Tab(9); Format$(ERQ, "#.#####0");
        Print Tab(19); Format$(FAC, "#.#####0")
        Print
        For J = 1 To NE
            Print Tab(9); Format$(KMAX(J), "##0"); Tab(19); Format$(ERMAX(J), "#.#####0")
        Next J
        Print
        If ERQ < CONV Then Exit For
    Next IT
End Sub