lfit.txt

数据拟合源程序

Sub LFIT(X(), Y(), SIG(), NDATA, A(), MA, LISTA(), MFIT, COVAR(), NCVM, CHISQ)
    Dim BETA(50), AFUNC(50)
    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 set in LISTA"
        End If
    Next J
    If KK <> (MA + 1) Then Print " Improper set in LISTA"
    For J = 1 To MFIT
        For K = 1 To MFIT
            COVAR(J, K) = 0#
        Next K
        BETA(J) = 0#
    Next J
    For I = 1 To NDATA
        Call FUNCS(X(I), AFUNC, MA)
        YM = Y(I)
        If MFIT < MA Then
            For J = MFIT + 1 To MA
                YM = YM - A(LISTA(J)) * AFUNC(LISTA(J))
            Next J
        End If
        SIG2I = 1# / SIG(I) ^ 2
        For J = 1 To MFIT
            WT = AFUNC(LISTA(J)) * SIG2I
            For K = 1 To J
                COVAR(J, K) = COVAR(J, K) + WT * AFUNC(LISTA(K))
           Next K
            BETA(J) = BETA(J) + YM * WT
        Next J
    Next I
    If MFIT > 1 Then
        For J = 2 To MFIT
            For K = 1 To J - 1
                COVAR(K, J) = COVAR(J, K)
            Next K
        Next J
    End If
    Call GAUSSJ(COVAR(), MFIT, BETA())
    For J = 1 To MFIT
        A(LISTA(J)) = BETA(J)
    Next J
    CHISQ = 0#
    For I = 1 To NDATA
        Call FUNCS(X(I), AFUNC, MA)
        Sum = 0#
        For J = 1 To MA
            Sum = Sum + A(J) * AFUNC(J)
        Next J
        CHISQ = CHISQ + ((Y(I) - Sum) / SIG(I)) ^ 2
    Next I
    Call COVSRT(COVAR, NCVM, MA, LISTA, MFIT)
End Sub