[½»Á÷] ¡¾ÇóÖú¡¿Çë½ÌÒ»¸öVB³ÌÐò

Private Sub Commmand1_Click()
'PROGRAM D2R11
'DRIVER for routine SPLIN2
M = 10
N = 10
Dim X1(10), X2(10), Y(10, 10), Y2(10, 10)
For I = 1 To M
    X1(I) = 0.2 * I
Next I
For I = 1 To N
    X2(I) = 0.2 * I
Next I
For I = 1 To M
  For J = 1 To N
  X1X2 = X1(I) * X2(J)
  Y(I, J) = X1X2 * Exp(-X1X2)
  Next J
Next I
Call SPLIE2(X1(), X2(), Y(), M, N, Y2())
Print
Print Tab(5); "X1 X2 SPLIN2 ACTUAL'"
For I = 1 To 10
   XX1 = 0.1 * I
   XX2 = XX1 ^ 2
   Call SPLIN2(X1(), X2(), Y(), Y2(), M, N, XX1, XX2, F)
   X1X2 = XX1 * XX2
   FF = X1X2 * Exp(-X1X2)
   Print Tab(3); Format$(XX1, "0.###000"),
   Print Format$(F, "0.###000"),
   Print Format$(FF, "0.###000")
Next I
End Sub
Sub SPLIE2(X1A(), X2A(), YA(), M, N, Y2A())
Dim YTMP(100), Y2TMP(100)
For J = 1 To M
  For K = 1 To N
   YTMP(K) = YA(J, K)
   Next K
  Call SPLINE(X2A(), YTMP(), N, 1E+30, 1E+30, Y2TMP())
  For K = 1 To N
    Y2A(A, K) = Y2TMP(K)
  Next K
Next J
End Sub
Sub SPLIN2(X1A(), X2A(), YA(), Y2A(), M, N, X1, X2, Y)
Dim YTMP(100), Y2TMP(100), YYTMP(100)
For J = 1 To M
For K = 1 To N
  YTMP(K) = YA(J, K)
  Y2TMP(K) = Y2A(J, K)
Next K
Call SPLINT(X2A(), YTMP, Y2TMP, N, X2, YYTMP(J))
Next J
Call SPLINE(X1A, YYTMP, M, 1E+30, 1E+30, Y2TMP)
Call SPLINT(X1A, YYTMP, Y2TMP, M, X1, Y)
End Sub
Sub SPLINT(XA(), YA(), Y2A(), N, X, Y)
KLO = 1
KHI = N
1 If KHI - KLO > 1 Then
  K = (KHI + KLO) / 2
  If XA(K) > X Then
    KHI = K
  Else
    KLO = K
  End If
  GoTo 1
End If
H = XA(KHI) - XA(KLO)
If H = 0 Then
   Print "PAUSE 'BAD XA INPUT'"
   Exit Sub
End If
A = (XA(KHI) - X) / H
B = (X - XA(KLO)) / H
AAA = A * YA(KLO) + B * YA(KHI)
BBB = (A ^ 3 - A) * Y2A(KLO) + (B ^ 3 - B) * Y2A(KHI)
Y = AAA + BBB * (H ^ 2) / 6#
End Sub
Sub SPLINE(X(), Y(), N, YP1, YPN, Y2())
Dim U(100)
If YP1 > 9.9E+29 Then
   Y2(1) = 0
   U(1) = 0
Else
  Y2(1) = -0.5
  AAA = (Y(2) - Y(1)) / (X(2) - X(1))
  U(1) = (3# / (X(2) - X(1))) * (AAA - YP1)
End If
For I = 2 To N - 1
  SIG = (X(I) - X(I - 1)) / (X(I + 1) - X(I - 1))
  P = SIG * Y2(I - 1) + 2#
  Y2(I) = (SIG - 1#) / P
  AAA = (Y(I + 1) - Y(I)) / (X(I + 1) - X(I))
  BBB = (Y(I) - Y(I - 1)) / (X(I) - X(I - 1))
  CCC = X(I + 1) - X(I - 1)
  U(1) = (6# * (AAA - BBB) / CCC - SIG * U(I - 1)) / P
Next I
If YPN > 9.9E+29 Then
  QN = 0#
  UN = 0#
Else
  QN = 0.5
  AAA = YPN - (Y(N) - Y(N - 1)) / (X(N) - X(N - 1))
  UN = (3# / (X(N) - X(N - 1))) * AAA
End If
Y2(N) = (UN - QN * U(N - 1)) / (QN * Y2(N - 1) + 1#)
For K = N - 1 To 1 Step -1
    Y2(K) = Y2(K) * Y2(K + 1) + U(K)
Next K
End Sub

Originally posted by zyj8119 at 2010-08-26 12:34:09:
ÔËÐеÄʱºò£¬ÊÇÒªÏÈÔÚ½çÃæÉÏ»­Ò»¸öCOMMAND CLICKÂð£¿È»ºóÔËÐгÌÐò£¬µã»÷Õâ¸öCOMMAND CLICK?