d9r8a.txt

数据拟合源程序

Private Sub Command1_Click()
    'PROGRAM D9R8A
    'Driver for routine MRQMIN
    NPT = 100
    MA = 6
    SPREAD = 0.001
    Dim X(100), Y(100), SIG(100), A(6), LISTA(6)
    Dim COVAR(6, 6), ALPHA(6, 6), GUES(6)
    A(1) = 5#: A(2) = 2#: A(3) = 3#: A(4) = 2#: A(5) = 5#: A(6) = 3#
    GUES(1) = 4.5: GUES(2) = 2.2: GUES(3) = 2.8
    GUES(4) = 2.5: GUES(5) = 4.9: GUES(6) = 2.8
    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
    ALAMDA = -1
    For I = 1 To MA
        A(I) = GUES(I)
    Next I
    Call MRQMIN(X(), Y(), SIG(), NPT, A(), MA, LISTA(), MFIT, COVAR(), ALPHA(), MA, CHISQ, ALAMDA)
    K = 1
    ITST = 0
1   Print "Iteration #"; K; "Chi-squared: ";
    Print Format$(CHISQ, "#####.##00");
    Print "   ALAMDA: "; Format$(ALAMDA, ".##E+00")
    Print Tab(5)
    Print Tab(3); "A(1)   A(2)    A(3)    A(4)    A(5)    A(6)"
    For I = 1 To MA
        Print Format$(A(I), "#.###0"),
    Next I
    Print Tab(5)
    K = K + 1
    OCHISQ = CHISQ
    Call MRQMIN(X(), Y(), SIG(), NPT, A(), MA, LISTA(), MFIT, COVAR(), ALPHA(), MA, CHISQ, ALAMDA)
    If CHISQ > OCHISQ Then
        ITST = 0
    ElseIf Abs(OCHISQ - CHISQ) < 0.1 Then
        ITST = ITST + 1
    End If
    If ITST < 2 Then
        GoTo 1
    End If
    ALAMDA = 0#
    Call MRQMIN(X(), Y(), SIG(), NPT, A(), MA, LISTA(), MFIT, COVAR(), ALPHA(), MA, CHISQ, ALAMDA)
    Print Tab(5); "Uncertainties:"
    For I = 1 To MA
        Print Format$(Sqr(COVAR(I, I)), "#.###0"),
    Next I
    Print Tab(5); "Expected results:"
    Print Tab(2); "5.0     2.0     3.0     2.0     5.0     3.0"
End Sub