mrqmin.txt

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

Static Sub MRQMIN(X(), Y(), SIG(), NDATA, A(), MA, LISTA(), MFIT, COVAR(), ALPHA(), NCA, CHISQ, ALAMDA)
    Dim ATRY(20), BETA(20), DA(20)
    If ALAMDA < 0# Then
        KK = MFIT + 1
        For J = 1 To MA
            IHIT = 0
            For K = 1 To MFIT
                If LISTA(K) = J Then IHIT = IHIT + 1
            Next K
            If IHIT = 0 Then
                LISTA(KK) = J
                KK = KK + 1
            ElseIf IHIT > 1 Then
                Print "Improper permutation in LISTA"
                Exit Sub
            End If
        Next J
        If KK <> MA + 1 Then Print "Improper permutation in LISTA"
        ALAMDA = 0.001
        Call MRQCOF(X(), Y(), SIG(), NDATA, A(), MA, LISTA(), MFIT, ALPHA(), BETA(), NCA, CHISQ)
        OCHISQ = CHISQ
        For J = 1 To MA
            ATRY(J) = A(J)
        Next J
    End If
    For J = 1 To MFIT
        For K = 1 To MFIT
            COVAR(J, K) = ALPHA(J, K)
        Next K
        COVAR(J, J) = ALPHA(J, J) * (1# + ALAMDA)
        DA(J) = BETA(J)
    Next J
    Call GAUSSJ(COVAR(), MFIT, DA())
    If ALAMDA = 0# Then
        Call COVSRT(COVAR(), NCA, MA, LISTA(), MFIT)
        Erase DA, ATRY
        Exit Sub
    End If
    For J = 1 To MFIT
        ATRY(LISTA(J)) = A(LISTA(J)) + DA(J)
    Next J
    Call MRQCOF(X(), Y(), SIG(), NDATA, ATRY(), MA, LISTA(), MFIT, COVAR(), DA(), NCA, CHISQ)
    If CHISQ < OCHISQ Then
        ALAMDA = 0.1 * ALAMDA
        OCHISQ = CHISQ
        For J = 1 To MFIT
            For K = 1 To MFIT
                ALPHA(J, K) = COVAR(J, K)
            Next K
            BETA(J) = DA(J)
            A(LISTA(J)) = ATRY(LISTA(J))
        Next J
    Else
        ALAMDA = 10# * ALAMDA
        CHISQ = OCHISQ
    End If
    Erase DA, ATRY
End Sub