d9r2.txt

数据拟合源程序

Private Sub Command1_Click()
    'PROGRAM D9R2
    'Driver for routine LFIT
    NPT = 100
    SPREAD = 0.1
    NTERM = 3
    Dim X(100), Y(100), SIG(100), A(3), LISTA(3), COVAR(3, 3)
    IDUM& = -911
    For I = 1 To NPT
        X(I) = 0.1 * I
        Y(I) = NTERM
        For J = NTERM - 1 To 1 Step -1
            Y(I) = J + Y(I) * X(I)
        Next J
        Y(I) = Y(I) + SPREAD * GASDEV(IDUM&)
        SIG(I) = SPREAD
    Next I
    MFIT = NTERM
    For I = 1 To MFIT
        LISTA(I) = I
    Next I
    Call LFIT(X(), Y(), SIG(), NPT, A(), NTERM, LISTA(), MFIT, COVAR(), NTERM, CHISQ)
    Print Tab(8); "PARAMETER           Uncertainty"
    For I = 1 To NTERM
        Print Tab(5); "A("; I; ")= "; Format$(A(I), "##.000000"),
        Print Format$(Sqr(COVAR(I, I)), "##.000000")
    Next I
    Print Tab(5)
    Print Tab(5); "Chi-squared =  "; Format$(CHISQ, ".###000E+00")
    Print Tab(5)
    Print Tab(5); "Full covariance matrix"
    For I = 1 To NTERM
        For J = 1 To NTERM
            Print Tab(8 + (J - 1) * 13); Format$(COVAR(I, J), ".00E+00");
        Next J
    Next I
    'Now test the LISTA feature
    For I = 1 To NTERM
        LISTA(I) = NTERM + 1 - I
    Next I
    Call LFIT(X(), Y(), SIG(), NPT, A(), NTERM, LISTA(), MFIT, COVAR(), NTERM, CHISQ)
    Print Tab(5)
    Print Tab(8); "PARAMETER           Uncertainty"
    For I = 1 To NTERM
        Print Tab(5); "A("; I; ")= "; Format$(A(I), "##.000000"),
        Print Format$(Sqr(COVAR(I, I)), "##.000000")
    Next I
    Print Tab(5)
    Print Tab(5); "Chi-squared =  "; Format$(CHISQ, ".###000E+00")
    Print Tab(5)
    Print Tab(5); "Full covariance matrix"
    For I = 1 To NTERM
        For J = 1 To NTERM
            Print Tab(8 + (J - 1) * 13); Format$(COVAR(I, J), ".00E+00");
        Next J
    Next I
    'Now check results of restricting fit parameters
    II = 1
    For I = 1 To NTERM
        AAA = I - Int(I / 2) * 2
        If AAA = 1 Then
            LISTA(II) = I
            II = II + 1
        End If
    Next
    MFIT = II - 1
    Call LFIT(X(), Y(), SIG(), NPT, A(), NTERM, LISTA(), MFIT, COVAR(), NTERM, CHISQ)
    Print Tab(5)
    Print Tab(8); "PARAMETER           Uncertainty"
    For I = 1 To NTERM
        Print Tab(5); "A("; I; ")= "; Format$(A(I), "##.000000"),
        Print Format$(Sqr(COVAR(I, I)), "##.000000")
    Next
    Print Tab(5)
    Print Tab(5); "Chi-squared = "; Format$(CHISQ, ".###000E+00")
    Print Tab(5)
    Print Tab(5); "Full covariance matrix"
    For I = 1 To NTERM
        For J = 1 To NTERM
            Print Tab(8 + (J - 1) * 13); Format$(COVAR(I, J), ".00E+00");
        Next J
    Next I
End Sub
Sub FUNCS(X, AFUNC, MA)
    AFUNC(1) = 1#
    For I = 2 To MA
        AFUNC(I) = X * AFUNC(I - 1)
    Next I
End Sub