svdfit.txt

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

Sub SVDFIT(X(), Y(), SIG(), NDATA, A(), MA, U(), V(), W(), MP, NP, CHISQ, FUNCS$)
    TOL = 0.00001
    Dim B(1000), AFUNC(50)
    For I = 1 To NDATA
        If FUNCS$ = "FPOLY" Then Call FPOLY(X(I), AFUNC(), MA)
        If FUNCS$ = "FLEG" Then Call FLEG(X(I), AFUNC(), MA)
        TMP = 1# / SIG(I)
        For J = 1 To MA
            U(I, J) = AFUNC(J) * TMP
        Next J
        B(I) = Y(I) * TMP
    Next I
    Call SVDCMP(U(), NDATA, MA, W(), V())
    WMAX = 0#
    For J = 1 To MA
        If W(J) > WMAX Then WMAX = W(J)
    Next J
    THRESH = TOL * WMAX
    For J = 1 To MA
        If W(J) < THRESH Then W(J) = 0#
    Next J
    Call SVBKSB(U(), W(), V(), NDATA, MA, B(), A())
    CHISQ = 0#
    For I = 1 To NDATA
        If FUNCS$ = "FPOLY" Then Call FPOLY(X(I), AFUNC(), MA)
        If FUNCS$ = "FLEG" Then Call FLEG(X(I), AFUNC(), MA)
        SUM1 = 0#
        For J = 1 To MA
            SUM1 = SUM1 + A(J) * AFUNC(J)
        Next J
        CHISQ = CHISQ + ((Y(I) - SUM1) / SIG(I)) ^ 2
    Next I
End Sub