d9r8b.txt

数据拟合源程序

Private Sub Command1_Click()
    'PROGRAM D9R8B
    'Driver for routine MRQCOF
    NPT = 100
    MA = 6
    SPREAD = 0.1
    Dim X(100), Y(100), SIG(100), A(6), LISTA(6)
    Dim COVAR(6, 6), ALPHA(6, 6), GUES(6), BETA(6)
    A(1) = 5#: A(2) = 2#: A(3) = 3#: A(4) = 2#: A(5) = 5#: A(6) = 3#
    GUES(1) = 4.9: GUES(2) = 2.1: GUES(3) = 2.9
    GUES(4) = 2.1: GUES(5) = 4.9: GUES(6) = 3.1
    IDUM& = -911
    'First try a sum of two Gaussians
    For I = 1 To 100
        X(I) = 0.1 * I
        Y(I) = 0#
        For J = 1 To 4 Step 3
            Y(I) = Y(I) + A(J) * Exp(-((X(I) - A(J + 1)) / A(J + 2)) ^ 2)
        Next J
        Y(I) = Y(I) * (1# + SPREAD * GASDEV(IDUM&))
        SIG(I) = SPREAD * Y(I)
    Next I
    MFIT = MA
    For I = 1 To MFIT
        LISTA(I) = I
    Next I
    For I = 1 To MA
        A(I) = GUES(I)
    Next I
    Call MRQCOF(X(), Y(), SIG(), NPT, A(), MA, LISTA(), MFIT, ALPHA(), BETA(), MA, CHISQ)
    Print Tab(5)
    Print Tab(5); "matrix alpha"
    Print Tab(5)
    For I = 1 To MA
        For J = 1 To MA
            Print Tab((J - 1) * 12); Format$(ALPHA(I, J), "####.###0");
        Next J
        Print
    Next I
    Print Tab(5)
    Print Tab(5); "vector beta"
    Print Tab(5)
    For I = 1 To MA
        Print Format$(BETA(I), "###.###0"),
    Next I
    Print Tab(5)
    Print Tab(5); "Chi-squared: "; Format$(CHISQ, "###.####")
    Print Tab(5)
    'Next fix one line and improve the other
    For I = 1 To 3
        LISTA(I) = I + 3
    Next I
    MFIT = 3
    For I = 1 To MA
        A(I) = GUES(I)
    Next I
    Call MRQCOF(X(), Y(), SIG(), NPT, A(), MA, LISTA(), MFIT, ALPHA(), BETA(), MA, CHISQ)
    Print Tab(5); "matrix alpha"
    Print Tab(5)
    For I = 1 To MFIT
        For J = 1 To MFIT
            Print Tab((J - 1) * 12); Format$(ALPHA(I, J), "####.###0");
        Next J
        Print
    Next I
    Print Tab(5)
    Print Tab(5); "vector beta"
    Print Tab(5)
    For I = 1 To MFIT
        Print Format$(BETA(I), "###.###0"),
    Next I
    Print Tab(5)
    Print Tab(5); "Chi-squared: "; Format$(CHISQ, "###.###0")
End Sub