VBAで粒子法を勉強中

メッシュレスで数値解析できるという、粒子法に興味を持ち、勉強中です。 プログラムのスキルが無い為、ExcelとVBAでのプログラム作成を目指しています。

【SPH粒子法のプログラムをVBAで作ってみる】 8.一連の計算のまとめと粒子変位の表示

一連の計算のまとめと粒子変位の表示

 粒子の圧力計算、力の計算、変位の計算までの計算モジュールを記述したので、これをルーチンとしてまとめます。さらに、エクセル上で粒子の位置を表示するモジュールを作成します。

 計算モジュールと、表示モジュールを1つのルーチンとし、これを繰り返します。





 上記をプログラムにすると、以下の様になります。



'===========================
'粒子の圧力、力、変位の計算までのルーチン化:
'===========================
Private Sub process(Particles() As Particle)

  Call calculate_density_and_pressure(Particles())
  Call calculate_force(Particles())
  Call calculate_position(Particles())

End Sub





'===========================
'粒子の変位の表示:
'===========================
Private Sub output_particles(Particles() As Particle)

  Dim num As Integer  'カウンタ
  Dim iP As Integer   '粒子No


'---計算ループの7回に1度実行---------
If LOOPs Mod 7 = 1 Then
        
  '---カウンタをリセット---------
    num = 0
 
  
'---キャンバス代わりに白い枠無し長方形を描きます---------
'  (アクティブなシートに、400x200の大きさです)

    sN = ActiveSheet.Name
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1, 1, 400, 200).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
 
    Selection.ShapeRange.Line.Visible = msoFalse
        

    '---全ての粒子に対して実行---------
      
      For iP = 0 To nP - 1
       
    
    '--粒子を直径4の楕円のシェイプで示します---
    '  X座標は20+5X 、 Y座標は190-5X
        
        ActiveSheet.Shapes.AddShape(msoShapeOval _
        , 20 + 5 * Particles(iP).r.X - 2 _
        , 190 - 5 * Particles(iP).r.Y - 2 _
        , 4 _
        , 4 _
       ).Select
        With Selection.ShapeRange.Fill
            .Visible = msoTrue
           .ForeColor.RGB = RGB(0, 0, 255)
            .Transparency = 0
            .Solid
        End With
        Selection.ShapeRange.Line.Visible = msoFalse
          
    
      
    Next iP


'---シェイプをカットしてピクチャ貼付け---
    '---"描画"というシートに貼付けます---
    ActiveSheet.Shapes.SelectAll
    Selection.Cut
    Sheets("描画").Select
    Range("A1").Select
    
    '---ピクチャを最背面に移動します---
    ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)", Link:=False, _
        DisplayAsIcon:=False
    Selection.ShapeRange.ZOrder msoSendToBack
        
    '---元のアクティブシートに復帰---
    Sheets(sN).Select


''======================================
End If
  LOOPs = LOOPs + 1


End Sub



'===========================
'ルーチンを再帰呼び出しで回す:
'===========================
Private Sub smain(Particles() As Particle, iLoop As Integer)

  If iLoop > 0 Then

    '---初回のルーチン---
    Call process(Particles)
    
    '---描画ルーチン---
    Call output_particles(Particles)
    
    '---ここが再帰部分---
    Call smain(Particles(), iLoop - 1)

  Else
     Exit Sub
  End If
End Sub


 表示ルーチンは、エクセルのシェイプを利用して、長方形の上に粒子とみなした楕円を描き、これをピクチャとして貼り付けています。また、ルーチンの繰り返しは、再帰呼び出しで実現しています。

 一連のプログラムができましたので、次はメインモジュールでこれを動かしてみます。



にほんブログ村 科学ブログ 技術・工学へ
にほんブログ村

【SPH粒子法のプログラムをVBAで作ってみる】 7.各粒子の加速度、速度、変位の計算