sfroid.txt

常用的数值算法的VB程序

Dim X(41), H, MM, N, C2, ANORM
Private Sub Command1_Click()
    'PROGRAM SFROID
    NE = 3: M = 41: NB = 1: NCI = 3: NCJ = 3: NCK = 42
    NSI = 3: NSJ = 7: NYJ = 3: NYK = 41
    Dim SCALV(3), INDEXV(3), Y(3, 41), C(3, 3, 42), S(3, 7)
    ITMAX = 100
    CONV = 0.000005
    SLOWC = 1#
    H = 1# / (M - 1)
    C2 = 0#
    Print "ENTER M,N"
    MM = 2
    N = 2
    If (N + MM Mod 2) = 1 Then
        INDEXV(1) = 1
        INDEXV(2) = 2
        INDEXV(3) = 3
    Else
        INDEXV(1) = 2
        INDEXV(2) = 1
        INDEXV(3) = 3
    End If
    ANORM = 1#
    If MM <> 0 Then
        Q1 = N
        For I = 1 To MM
            ANORM = -0.5 * ANORM * (N + I) * (Q1 / I)
            Q1 = Q1 - 1#
        Next I
    End If
    For K = 1 To M - 1
        X(K) = (K - 1) * H
        FAC1 = 1# - X(K) ^ 2
        FAC2 = FAC1 ^ (-MM / 2#)
        Y(1, K) = PLGNDR(N, MM, X(K)) * FAC2
        DERIV = -((N - MM + 1) * PLGNDR(N + 1, MM, X(K)) - (N + 1) * X(K) * PLGNDR(N, MM, X(K))) / FAC1
        Y(2, K) = MM * X(K) * Y(1, K) / FAC1 + DERIV * FAC2
        Y(3, K) = N * (N + 1) - MM * (MM + 1)
    Next K
    X(M) = 1#
    Y(1, M) = ANORM
    Y(3, M) = N * (N + 1) - MM * (MM + 1)
    Y(2, M) = (Y(3, M) - C2) * Y(1, M) / (2# * (MM + 1#))
    SCALV(1) = Abs(ANORM)
    If Y(2, M) > Abs(ANORM) Then
        SCALV(2) = Y(2, M)
    Else
        SCALV(2) = Abs(ANORM)
    End If
    If Y(3, M) > 1 Then
        SCALV(3) = Y(3, M)
    Else
        SCALV(3) = 1
    End If
    Do
      Print "ENTER C^2 OR  999 TO END"
      MSG1$ = "ENTER C^2 OR  999 TO END"
      MSG$ = InputBox$(MSG1$, "INPUT C^2", "0.1")
      C2 = Val(MSG$)
      Print C2
      If C2 = 999 Or MSG$ = "" Then Exit Do
      Call SOLVDE(ITMAX, CONV, SLOWC, SCALV(), INDEXV(), NE, NB, M, Y(), NYJ, NYK, C(), NCI, NCJ, NCK, S(), NSI, NSJ)
      Print "M = "; MM, "    N = "; N; "    C^2 = "; C2;
      Print "    LAMBDA = "; Y(3, 1) + MM * (MM + 1)
      Print
    Loop
End Sub