VBA Private Private Private As Boolean KX As
VBAによる定義 ①データ宣言 Private Private Private ポアソン As Boolean KX As Integer KY As Integer NN As Integer EPS As Double U() As Double ID 1 As Integer ID 2 As Integer F() As Double UMax As Double UMin As Double UDX As Double
②初期条件の設定と境界条件設定 Private Sub 初期条件(KX, KY, MX, MY, DX, DY) For j = 0 To KY For i = 0 To KX U(0, i, j) = 0: U(1, i, j) = 0: F(i, j) = 0 If ポアソン Then ‘ ポアソンの方程式のとき右辺設定 F(i, j) = 80 * (DX * (MX - i) + DY * (MY - j)) End if Next End Sub Private Sub 境界条件(KX, KY, DX, DY) For k = 0 To 1 For i = 0 To KX: U(k, i, 0) = 0: U(k, i, KY) = 16: Next For j = 0 To KY: U(k, 0, j) = 0: U(k, KX, j) = 8: Next End Sub
③計算本体(その1) Private Sub 計算(KX, KY, NN, EPS) Dim MX As Integer: MX = KX + 1 Dim MY As Integer: MY = KY + 1 Dim DX As Double: DX = 1# / KX Dim DY As Double: DY = 1# / KY Re. Dim U(1, KX, KY), F(KX, KY) Dim F 1 As Double: F 1 = 1 / (DX * DX) Dim F 2 As Double: F 2 = 1 / (DY * DY) Dim F 3 As Double: F 3 = 0. 5 / (F 1 + F 2) 初期条件 KX, KY, MX, MY, DX, DY 境界条件 KX, KY, DX, DY
④計算本体(その2) ' 収斂計算 ID 1 = 1: ID 2 = 0 For N = 0 To NN - 1 ID = ID 1: ID 1 = ID 2: ID 2 = ID: ER = 0 For j = 1 To KY - 1 For i = 1 To KX - 1 U(ID 2, i, j) = F 3 * (F 1 * (U(ID 1, i + 1, j) + U(ID 1, i, j + 1)) + _ F 2 * (U(ID 1, i - 1, j) + U(ID 1, i, j - 1)) + F(i, j)) If Abs(U(ID 2, i, j)) > EPS Then E = Abs((U(ID 2, i, j) - U(ID 1, i, j)) / U(ID 2, i, j)) If E > ER Then ER = E End If Next
⑤計算本体(その3) If ER < EPS Then Exit For If (N Mod 50) = 0 Then ‘ 計算途中経過表示 With Worksheets("データ"). Cells(2, 5) = N. Cells(2, 6) = Format(ER, "#0. 000000") End With Application. Screen. Updating = True Application. Screen. Updating = False End If Next Application. Screen. Updating = True End Sub
⑥データの設定 Sub データ設定() With Worksheets("データ") KX = Val(. Cells(2, 1)) KY = Val(. Cells(2, 2)) NN = Val(. Cells(2, 3)) EPS = Val(. Cells(2, 4)) End With ポアソン = False End Sub
⑦結果の設定 Sub 結果設定() With Worksheets("結果") UMax = U(ID 2, 1, 1): UMin = U(ID 2, 1, 1) For j = 1 To KY - 1 For i = 1 To KX - 1. Cells(j, i) = U(ID 2, i, j) If UMax < U(ID 2, i, j) Then UMax = U(ID 2, i, j) If UMin > U(ID 2, i, j) Then UMin = U(ID 2, i, j) Next UDX = UMax - UMin End With End Sub
⑨結果を分布図としてセルの色で表示する処理 Sub ボタン 2_Click() Dim CD(10) As Integer CD(0) = 5: CD(1) = 41: CD(2) = 33: CD(3) = 34: CD(4) = 36 CD(5) = 6: CD(6) = 44: CD(7) = 45: CD(8) = 46: CD(9) = 3 Worksheets("分布"). Select MY = KY + 1 With Worksheets("結果") For j = 1 To KY - 1 For i = 1 To KX - 1 ID = 9 * (Val(. Cells(KY - j, i) - UMin) / UDX) If ID > 9 Then ID = 9 Worksheets("分布"). Cells(j, i). Selection. Interior. Color. Index = CD(ID) Selection. Interior. Pattern = xl. Solid Next End With End Sub
VBAによる定義 ①データ宣言と初期値設定 Private Z(2, 100) As Double Private V(2, 100) As Double Private ID 1 As Integer Private ID 2 As Integer Sub 初期値() For i = 0 To 50 A = Sin(3. 14159265359 * i / 100) Z(0, i) = A: Z(0, 100 - i) = A ‘ 端点での誤差を少なくするために V(0, 100 - i) = 0: V(0, i) = 0 ‘ このように設定している Next With Worksheets("結果") For i = 0 To 100. Cells(1, i + 2) = i. Cells(2, i + 2) = Z(0, i) Next End With End Sub
VBAによる定義 ②処理本体(その1) Sub 波動方程式 1次元(Num. Loop, NN, Save. N, DT, DX, Alfa) Beta = Alfa * Alfa / (DX * DX): ID 1 = 0: ID 2 = 1: KK = 0 For k = 1 To Num. Loop For j = 1 To NN - 1 Z(ID 2, j) = Z(ID 1, j) + DT * V(ID 1, j) Acc = Beta * (Z(ID 1, j + 1) - 2 * Z(ID 1, j) + Z(ID 1, j - 1)) V(ID 2, j) = V(ID 1, j) + DT * Acc Next ‘ 境界条件(両端を固定とする) V(ID 2, 0) = 0: V(ID 2, 100) = 0 Z(ID 2, 0) = 0: Z(ID 2, 100) = 0
VBAによる定義 ③処理本体(その2)とボタンのClickイベントハンドラ If (k Mod Save. N) = 0 Then ‘ 指定された計算回数間隔で途中結果を保存する KK = KK + 1 With Worksheets("結果"). Cells(KK + 2, 1) = KK * Save. N * DT For j = 0 To NN. Cells(KK + 2, j + 2) = Z(ID 2, j) Next End With End If Temp = ID 2: ID 1 = ID 2: ID 2 = Temp Next End Sub ボタン 2_Click() 初期値 波動方程式 1次元 40000, 100, 0. 01, 0. 05 End Sub
Private Private Private T() As Double U() As Double: Private V() As Double ID 1 As Integer: Private ID 2 As Integer KX As Integer: Private KY As Integer MX As Integer: Private MY As Integer N As Integer: Private Num. Loop As Integer DT As Double: DX As Double: Private DY As Double R 1 As Double: Private R 2 As Double R 3 As Double: Private R 4 As Double Ndisp As Integer VBAによる定義 ①データ宣言
Sub 初期値設定() With Worksheets("データ") KX = Val(. Cells(2, 1)): KY = Val(. Cells(2, 2)) DT = Val(. Cells(2, 3)): Num. Loop = Val(. Cells(2, 4)) Ndisp = Val(. Cells(2, 5)) MX = KX + 1: MY = KY + 1 Re. Dim T(2, MX, MY), U(MX, MY), V(MX, MY) DX = 1# / KX: DY = 1# / KY R 1 = 2 * DT / DX: R 2 = 2 * DT / DY R 3 = DT / (DX * DX): R 4 = DT / (DY * DY) ' 初期条件 For j = 0 To KY For i = 0 To KX T(0, i, j) = 0#: T(1, i, j) = 0# YY = DY * j U(i, j) = 50# * YY * (1# - YY) V(i, j) = 0 Next N = 0: ID 1 = 0: ID 2 = 1 End With End Sub VBAによる定義 ②初期値設定
Private Sub 計算() 'オイラーの解法 For j = 1 To KY - 1 For i = 1 To KX - 1 T(ID 2, i, j) = T(ID 1, i, j) _ - R 1 * U(i, j) * (T(ID 1, i + 1, - R 2 * V(i, j) * (T(ID 1, i, j + + R 3 * (T(ID 1, i + 1, j) - 2# * _ + R 4 * (T(ID 1, i, j + 1) - 2# * Next ID = ID 2: ID 2 = ID 1: ID 1 = ID End Sub VBAによる定義 ④計算実行 j) - T(ID 1, i - 1, j)) _ 1) - T(ID 1, i, j - 1)) _ T(ID 1, i, j) + T(ID 1, i - 1, j)) T(ID 1, i, j) + T(ID 1, i, j - 1))
VBAによる定義 ⑤表示ルーチン(その1) Sub 表示() Dim CD(10) As Integer CD(0) = 5: CD(1) = 41: CD(2) = 33: CD(3) = 34: CD(4) = 36 CD(5) = 6: CD(6) = 44: CD(7) = 45: CD(8) = 46: CD(9) = 3 Worksheets("分布"). Select MY = KY + 1 Application. Screen. Updating = False Worksheets("分布"). Select With Worksheets("結果") For j = 0 To KY: For i = 0 To KX. Cells(i + 1, j + 1) = T(ID 1, j, i) Next: Next Umax = 1: Umin = 0 UDX = Umax - Umin
VBAによる定義 ⑥表示ルーチン(その2) For j = 1 To KY - 1: For i = 1 To KX - 1 If UDX = 0 Then ID = 0 Else ID = 9 * (Val(. Cells(j, i) - Umin) / UDX) End If If ID < 0 Then ID = 0 If ID > 9 Then ID = 9 Worksheets("分布"). Cells(j, i). Selection. Interior. Color. Index = CD(ID) Selection. Interior. Pattern = xl. Solid Next: Next End With Worksheets("分布"). Cells(KY + 4, KX + 4). Select Application. Screen. Updating = True End Sub
- Slides: 52