d15r2.txt

VB常用数值算法集2

Dim C2, M, N, FACTR, DX
Dim KMAX, KOUNT, DXSAV
Private Sub Command1_Click()
    'PROGRAM D15R2
    'Driver for routine SHOOTF
    NVAR = 3: N1 = 2: N2 = 1: DELTA = 0.001: EPS = 0.000001
    DXX = 0.0001: KMAX = 100
    Dim V1(1), DELV1(1), V2(2), DELV2(2), DV1(1), DV2(2), F(3)
    Do
      Print "Input M,N,C-Squared (999 to end)"
      M = 2
      N = 2
      C2 = 0.1
      If C2 = 999 Then End
      If (N < M) Or (M < 0) Then Print "Improper arguments"
    Loop While N < M Or M < 0
    Print Tab(5); M; Tab(10); N; Tab(15); C2
    FACTR = 1
    If M <> 0 Then
        Q1 = N
        For I = 1 To M
            FACTR = -0.5 * FACTR * (N + I) * (Q1 / I)
            Q1 = Q1 - 1
        Next I
    End If
    DX = DXX
    V1(1) = N * (N + 1) - M * (M + 1) + C2 / 2#
    If ((N - M) Mod 2) = 0 Then
        V2(1) = FACTR
    Else
        V2(1) = -FACTR
    End If
    V2(2) = V1(1) + 1
    DELV1(1) = DELTA * V1(1)
    DELV2(1) = DELTA * FACTR
    DELV2(2) = DELV1(1)
    H1 = 0.1
    HMIN = 0
    X1 = -1 + DX
    X2 = 1 - DX
    XF = 0
    Print "           Mu(-1)      Y(1-dx)          Mu(+1)"
    Do
    Call SHOOTF(NVAR, V1(), V2(), DELV1(), DELV2(), N1, N2, X1, X2, XF, EPS, H1, HMIN, F(), DV1(), DV2())
    Print Tab(2); "V       "; Format$(V1(1), "##.#####0"); Tab(22); Format$(V2(1), "#.#####0");
    Print Tab(40); Format$(V2(2), "##.#####0")
    Print Tab(2); "DV      "; Format$(DV1(1), "#.#####0"); Tab(22); Format$(DV2(1), "#.#####0");
    Print Tab(40); Format$(DV2(2), "#.#####0")
    Print
    Loop While Abs(DV1(1)) > Abs(EPS * V1(1))
End Sub
Sub LOAD1(X1, V1(), Y())
    Y(3) = V1(1)
    Y(2) = -(Y(3) - C2) * FACTR / 2# / (M + 1#)
    Y(1) = FACTR + Y(2) * DX
End Sub
Sub LOAD2(X2, V2(), Y())
    Y(3) = V2(2)
    Y(2) = (Y(3) - C2) * Y(1) / 2# / (M + 1#)
    Y(1) = V2(1)
End Sub
Sub SCORE(XF, Y(), F())
    For I = 1 To 3
        F(I) = Y(I)
    Next I
End Sub
Sub DERIVS(X, Y(), DYDX())
    DYDX(1) = Y(2)
    DYDX(3) = 0#
    DYDX(2) = (2# * X * (M + 1#) * Y(2) - (Y(3) - C2 * X * X) * Y(1)) / (1# - X * X)
End Sub