Option Explicit On Option Strict On Public Class Form1 Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click Call main() End Sub Private Sub main() '加速度応答スペクトル描画 Dim i As Integer Dim k As Integer Dim icase As Integer Dim ncase As Integer 'グラフ枚数 Dim nnn As Integer '1枚当たり描画線数 Dim datax(11, 200) As Double 'プロットデータ Dim datay(11, 200) As Double 'プロットデータ Dim ndata(11) As Integer '指定周期数(プロット点数) Dim pname(11) As String 'グラフ名称 Dim lcol(11) As String '線種(実践or点線) Dim memo As String 'グラフ名称 '入出力変数宣言 Dim sr As System.IO.StreamReader Dim sd As System.IO.StreamReader Dim dat As String Dim sbuf() As String Dim delim() As Char = {","c} Dim fname1 As String = "" Dim fni As String Dim fin() As String '時刻歴入力ファイル名 Dim dt As Double 'サンプリングピッチ Dim nn As Integer '時刻歴データ数 Dim ddy() As Double '加速度時刻歴 Dim dy() As Double '速度時刻歴 Dim y() As Double '変位時刻歴 Dim ddymax As Double '最大加速度 Dim dymax As Double '最大速度 Dim ymax As Double '最大変位 Dim nt As Integer = 100 '指定周期数 Dim tk() As Double '計算周期 Dim resacc() As Double '加速度応答値 Dim resvel() As Double '速度応答値 Dim resdis() As Double '変位応答値 Dim h As Double = 0.05 '減衰定数 Dim pi As Double = Math.PI Dim kcount As Integer = -1 Dim strcom As String h = CDbl(ToolStripTextBox2.Text) '入力ファイル選定とテキスト入力 OpenFileDialog1.InitialDirectory = My.Computer.FileSystem.CurrentDirectory If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then fname1 = OpenFileDialog1.FileName sr = New System.IO.StreamReader(fname1, System.Text.Encoding.Default) dat = sr.ReadLine() : sbuf = dat.Split(delim) ncase = CInt(sbuf(0)) - 1 'グラフ枚数確定 For icase = 0 To ncase dat = sr.ReadLine() : sbuf = dat.Split(delim) memo = sbuf(0) 'グラフ右上タイトル nnn = CInt(sbuf(1)) - 1 '1枚当たり描画線数 ReDim fin(nnn) For k = 0 To nnn dat = sr.ReadLine() : sbuf = dat.Split(delim) fin(k) = sbuf(0) '時刻歴ファイル名 pname(k) = sbuf(1) '描画線の名称 lcol(k) = sbuf(2) '線種指定 fni = System.IO.Path.GetDirectoryName(fname1) & "\" & fin(k) sd = New System.IO.StreamReader(fni, System.Text.Encoding.Default) dat = sd.ReadLine() dat = sd.ReadLine() : sbuf = dat.Split(delim) : dt = CDbl(sbuf(1)) dat = sd.ReadLine() : sbuf = dat.Split(delim) : nn = CInt(sbuf(1)) ReDim ddy(nn - 1) ReDim dy(nn - 1) ReDim y(nn - 1) ReDim tk(nt - 1) ReDim resacc(nt - 1) ReDim resvel(nt - 1) ReDim resdis(nt - 1) For i = 0 To nn - 1 dat = sd.ReadLine() : sbuf = dat.Split(delim) : ddy(i) = CDbl(sbuf(0)) Next i sd.Close() ndata(k) = nt - 1 For i = 0 To nt - 1 '周期範囲:2*dt〜10sec tk(i) = System.Math.Pow(10.0, Math.Log10(2.0 * dt) + (1.0 - Math.Log10(2.0 * dt)) / CDbl(nt) * CDbl(i)) Next i Call IACC(nn, dt, ddy, dy, y, ddymax, dymax, ymax) '加速度時刻歴数値積分 Call CRAC(nn, dt, ddy, dy, y, ddymax, dymax, ymax) '加速度時刻歴基線補正 Call ERES(nn, dt, h, ddy, nt, tk, resacc, resvel, resdis) '応答スペクトル計算 Select Case CInt(ToolStripTextBox3.Text) Case 0 For i = 0 To nt - 1 datay(k, i) = resacc(i) Next i Case 1 For i = 0 To nt - 1 datay(k, i) = resvel(i) Next i End Select For i = 0 To nt - 1 datax(k, i) = tk(i) Next i '加速度時刻歴波形描画 kcount = kcount + 1 strcom = memo & "_" & pname(k) Call WAVEPLOT(kcount, fname1, strcom, nn, dt, ddy, ddymax) Next k '応答スペクトル描画 Call SAKUZU(fname1, icase, nnn, ndata, datax, datay, pname, memo, lcol) Next icase sr.Close() End Sub Private Sub WAVEPLOT(ByVal kcount As Integer, ByVal fname1 As String, ByVal strcom As String, _ ByVal nn As Integer, ByVal dt As Double, ByRef ddy() As Double, ByVal ddymax As Double) 'グラフィック変数宣言 Dim kpt As Integer = 2 Dim HSIZE As Integer = 800 Dim DHL As Integer = 80 Dim DHR As Integer = 20 Dim VSIZE As Integer = 200 Dim DVL As Integer = 50 Dim DVU As Integer = 20 Dim sxjiku As String = "時刻(sec)" Dim syjiku As String = "加速度(gal)" Dim kxi0 As Integer : Dim kxf0 As Integer Dim kyi0 As Integer : Dim kyf0 As Integer Dim kxi As Integer : Dim kxf As Integer Dim kyi As Integer : Dim kyf As Integer Dim xmin As Double : Dim xmax As Double : Dim dx As Double Dim ymin As Double : Dim ymax As Double : Dim dy As Double Dim xx As Double : Dim yy As Double Dim kxx1 As Integer : Dim kyy1 As Integer Dim kxx2 As Integer : Dim kyy2 As Integer Dim str As String Dim bmp As Bitmap Dim g As Graphics Dim f As New Font("MS ゴシック", kpt * 10) Dim TextSize1 As New System.Drawing.SizeF Dim TextSize2 As New System.Drawing.SizeF Dim fname2 As String Dim sbuf() As String '作図用基本データ kxi0 = DHL : kxf0 = HSIZE - DHR kyi0 = DVU : kyf0 = VSIZE - DVL '画像書き出し PictureBox2.Size = New Size(kpt * HSIZE, kpt * VSIZE) PictureBox2.Visible = False bmp = New Bitmap(PictureBox2.Width, PictureBox2.Height) PictureBox2.Image = bmp g = Graphics.FromImage(PictureBox2.Image) g.FillRectangle(Brushes.White, 0, 0, PictureBox2.Width, PictureBox2.Height) kxi = kpt * kxi0 : kxf = kpt * kxf0 : kyi = kpt * kyi0 : kyf = kpt * kyf0 sbuf = ToolStripTextBox1.Text.Split(","c) xmin = CDbl(sbuf(0)) : xmax = CDbl(sbuf(1)) : dx = CDbl(sbuf(2)) ymin = -ddymax : ymax = ddymax : dy = ddymax '座標軸(xーy普通軸) Dim LPen As New System.Drawing.Pen(System.Drawing.Color.Black) LPen.DashStyle = Drawing2D.DashStyle.Dot Call DRN_XJIKU(g, f, LPen, kpt, xmin, xmax, dx, kxi, kxf, kyi, kyf) Call DRN_YJIKU(g, f, LPen, kpt, ymin, ymax, dy, kxi, kxf, kyi, kyf) '枠線描画 g.DrawRectangle(New Pen(Color.Black, 2), kxi, kyi, kxf - kxi, kyf - kyi) 'y軸名描画 str = syjiku TextSize2 = g.MeasureString(str, f) TextSize1 = g.MeasureString("-1.0", f) kxx1 = CInt(kxi - kpt * 15 - TextSize1.Width - TextSize2.Height) kyy1 = CInt((kyi + kyf) / 2 + TextSize2.Width / 2) Call INC_STR(g, f, str, kxx1, kyy1, -90) 'x軸名描画 str = sxjiku TextSize2 = g.MeasureString(str, f) kxx1 = CInt((kxi + kxf) / 2 - TextSize2.Width / 2) kyy1 = CInt(kyf + kpt * 10 + TextSize1.Height) Call INC_STR(g, f, str, kxx1, kyy1, 0) 'データを線で連結 xx = 0.0 yy = ddy(0) kxx1 = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) kyy1 = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) For i = 1 To nn - 1 xx = dt * CDbl(i) yy = ddy(i) If xmax < xx Then Exit For kxx2 = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) kyy2 = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) g.DrawLine(New Pen(Color.Blue, 1), kxx1, kyy1, kxx2, kyy2) kxx1 = kxx2 kyy1 = kyy2 Next i 'memo表示 TextSize1 = g.MeasureString(strcom, f) g.DrawString(strcom, f, Brushes.Black, kxf - TextSize1.Width, kyi - 1 * kpt - TextSize1.Height) f.Dispose() g.Dispose() '画像保存 fname2 = System.IO.Path.GetDirectoryName(fname1) & "\" & _ System.IO.Path.GetFileNameWithoutExtension(fname1) & "figwave_" & kcount.ToString("00") & ".png" PictureBox2.Image.Save(fname2, System.Drawing.Imaging.ImageFormat.Png) End Sub Private Sub SAKUZU(ByVal fname1 As String, ByVal icase As Integer, ByVal nnn As Integer, _ ByRef ndata() As Integer, ByRef datax(,) As Double, ByRef datay(,) As Double, _ ByRef pname() As String, ByVal memo As String, ByRef lcol() As String) 'グラフィック変数宣言 Dim kpt As Integer Dim HSIZE As Integer = 700 Dim DHL As Integer = 80 Dim DHR As Integer = 200 Dim VSIZE As Integer = 400 Dim DVL As Integer = 50 Dim DVU As Integer = 20 Dim kxi0 As Integer : Dim kxf0 As Integer Dim kyi0 As Integer : Dim kyf0 As Integer Dim thePicBox As PictureBox = PictureBox1 Dim bmp As Bitmap Dim g As Graphics Dim fname2 As String = "" Dim i As Integer '作図用基本データ kxi0 = DHL : kxf0 = HSIZE - DHR kyi0 = DVU : kyf0 = VSIZE - DVL For i = 0 To 1 Select Case i Case 0 '画面描画 kpt = 1 thePicBox = PictureBox1 thePicBox.Visible = True Case 1 '画像書き出し kpt = 2 thePicBox = PictureBox2 thePicBox.Visible = False End Select thePicBox.Size = New Size(kpt * HSIZE, kpt * VSIZE) bmp = New Bitmap(thePicBox.Width, thePicBox.Height) thePicBox.Image = bmp g = Graphics.FromImage(thePicBox.Image) g.FillRectangle(Brushes.White, 0, 0, thePicBox.Width, thePicBox.Height) Call PLOT(g, kpt, kxi0, kxf0, kyi0, kyf0, nnn, ndata, datax, datay, pname, memo, lcol) g.Dispose() Next i PictureBox1.Left = 0 PictureBox1.Top = ToolStrip1.Height Me.ClientSize = New Size(PictureBox1.Width, PictureBox1.Height + ToolStrip1.Height) '画像保存 Select Case CInt(ToolStripTextBox3.Text) Case 0 fname2 = System.IO.Path.GetDirectoryName(fname1) & "\" & _ System.IO.Path.GetFileNameWithoutExtension(fname1) & "-fig_acc" & CStr(icase) & ".png" Case 1 fname2 = System.IO.Path.GetDirectoryName(fname1) & "\" & _ System.IO.Path.GetFileNameWithoutExtension(fname1) & "-fig_vel" & CStr(icase) & ".png" End Select PictureBox2.Image.Save(fname2, System.Drawing.Imaging.ImageFormat.Png) End Sub Private Sub PLOT(ByVal g As Graphics, ByVal kpt As Integer, _ ByVal kxi0 As Integer, ByVal kxf0 As Integer, ByVal kyi0 As Integer, ByVal kyf0 As Integer, _ ByVal nnn As Integer, ByVal ndata() As Integer, ByRef datax(,) As Double, ByRef datay(,) As Double, _ ByRef pname() As String, ByVal memo As String, ByRef lcol() As String) Dim sxjiku As String = "" Dim syjiku As String = "" Dim xmin As Double Dim xmax As Double Dim ymin As Double Dim ymax As Double Dim i As Integer Dim k As Integer Dim kxi As Integer : Dim kxf As Integer Dim kyi As Integer : Dim kyf As Integer Dim xx As Double : Dim yy As Double Dim kxx1 As Integer : Dim kyy1 As Integer Dim kxx2 As Integer : Dim kyy2 As Integer Dim str As String Dim dc As Integer Dim f As New Font("MS ゴシック", kpt * 10) Dim TextSize1 As New System.Drawing.SizeF Dim TextSize2 As New System.Drawing.SizeF Select Case CInt(ToolStripTextBox3.Text) Case 0 syjiku = "加速度応答スペクトル(gal)" ymin = 1.0 : ymax = 4.0 Case 1 syjiku = "速度応答スペクトル(kine)" ymin = -1.0 : ymax = 3.0 End Select sxjiku = "周期(sec)" xmin = -2.0 : xmax = 1.0 kxi = kpt * kxi0 : kxf = kpt * kxf0 : kyi = kpt * kyi0 : kyf = kpt * kyf0 '座標軸(x−y対数軸) Dim LPen As New System.Drawing.Pen(System.Drawing.Color.Black) LPen.DashStyle = Drawing2D.DashStyle.Dot Call DRL_XJIKU(g, f, LPen, kpt, xmin, xmax, kxi, kxf, kyi, kyf) Call DRL_YJIKU(g, f, LPen, kpt, ymin, ymax, kxi, kxf, kyi, kyf) '枠線描画 g.DrawRectangle(New Pen(Color.Black, 2), kxi, kyi, kxf - kxi, kyf - kyi) 'y軸名描画 str = syjiku TextSize2 = g.MeasureString(str, f) TextSize1 = g.MeasureString("-1.0", f) kxx1 = CInt(kxi - kpt * 10 - TextSize1.Width - TextSize2.Height) kyy1 = CInt((kyi + kyf) / 2 + TextSize2.Width / 2) Call INC_STR(g, f, str, kxx1, kyy1, -90) 'x軸名描画 str = sxjiku TextSize2 = g.MeasureString(str, f) kxx1 = CInt((kxi + kxf) / 2 - TextSize2.Width / 2) kyy1 = CInt(kyf + kpt * 10 + TextSize1.Height) Call INC_STR(g, f, str, kxx1, kyy1, 0) 'データを線で連結 dc = 2 * kpt '線の太さ For k = 0 To nnn xx = Math.Log10(datax(k, 0)) yy = Math.Log10(datay(k, 0)) kxx1 = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) kyy1 = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) For i = 1 To ndata(k) xx = Math.Log10(datax(k, i)) yy = Math.Log10(datay(k, i)) kxx2 = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) kyy2 = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) LPen = CHG_LPEN(lcol(k)) LPen.Width = dc If kxx2 < kxf And kyy2 < kyf Then g.DrawLine(LPen, kxx1, kyy1, kxx2, kyy2) kxx1 = kxx2 kyy1 = kyy2 Next i Next k '凡例 TextSize1 = g.MeasureString("あ", f) kxx1 = kxf + 10 * kpt kxx2 = kxx1 + 20 * kpt For k = 0 To nnn kyy1 = kyi + (k + 1) * CInt(TextSize1.Height) LPen = CHG_LPEN(lcol(k)) LPen.Width = dc g.DrawLine(LPen, kxx1, kyy1, kxx2, kyy1) str = pname(k) kyy2 = kyy1 - CInt(TextSize1.Height / 2) g.DrawString(str, f, Brushes.Black, kxx2 + 2 * kpt, kyy2) Next k 'PGA表示 TextSize1 = g.MeasureString("あ", f) kxx1 = kxf + 10 * kpt kxx2 = kxx1 + 20 * kpt For k = 0 To nnn kyy1 = CInt((kyi + kyf) / 2) + (k + 1) * CInt(TextSize1.Height) LPen = CHG_LPEN(lcol(k)) LPen.Width = dc g.DrawLine(LPen, kxx1, kyy1, kxx2, kyy1) Select Case CInt(ToolStripTextBox3.Text) Case 0 str = datay(k, 0).ToString("0") & "gal (T=" & datax(k, 0).ToString("0.00") & "sec)" Case 1 str = datay(k, 0).ToString("0.0") & "kine (T=" & datax(k, 0).ToString("0.00") & "sec)" End Select kyy2 = kyy1 - CInt(TextSize1.Height / 2) g.DrawString(str, f, Brushes.Black, kxx2 + 2 * kpt, kyy2) Next k 'memo表示 TextSize1 = g.MeasureString(memo, f) g.DrawString(memo, f, Brushes.Black, kxf - TextSize1.Width, kyi - 1 * kpt - TextSize1.Height) '減衰定数表示 str = "h=" & ToolStripTextBox2.Text TextSize1 = g.MeasureString(str, f) g.DrawString(str, f, Brushes.Black, kxi + 5 * kpt, kyi - 1 * kpt - TextSize1.Height) f.Dispose() End Sub Private Function CHG_LPEN(ByVal str As String) As System.Drawing.Pen CHG_LPEN = New System.Drawing.Pen(System.Drawing.Color.Black) Select Case str.Substring(0, 1) Case "0" : CHG_LPEN = New System.Drawing.Pen(System.Drawing.Color.Red) Case "1" : CHG_LPEN = New System.Drawing.Pen(System.Drawing.Color.Blue) Case "2" : CHG_LPEN = New System.Drawing.Pen(System.Drawing.Color.Fuchsia) Case "3" : CHG_LPEN = New System.Drawing.Pen(System.Drawing.Color.Teal) Case "4" : CHG_LPEN = New System.Drawing.Pen(System.Drawing.Color.Aqua) Case "5" : CHG_LPEN = New System.Drawing.Pen(System.Drawing.Color.Lime) End Select Select Case str.Substring(1, 1) Case "s" : CHG_LPEN.DashStyle = Drawing2D.DashStyle.Solid Case "d" : CHG_LPEN.DashStyle = Drawing2D.DashStyle.Dot End Select End Function Private Sub INC_STR(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal str As String, _ ByVal kxx As Integer, ByVal kyy As Integer, ByVal ang As Single) '軸名描画 g.ScaleTransform(1.0, 1.0) '横・縦の表示比率を設定 g.TranslateTransform(kxx, kyy) '表示位置の設定(表示位置を原点とする座標移動) g.RotateTransform(ang) '表示角度を指定 g.DrawString(str, f, Brushes.Black, 0, 0) '描画実行 g.ResetTransform() '単位行列にリセット End Sub Private Sub DRN_XJIKU(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal LPen As System.Drawing.Pen, _ ByVal kpt As Integer, _ ByVal xmin As Double, ByVal xmax As Double, ByVal dx As Double, _ ByVal kxi As Integer, ByVal kxf As Integer, _ ByVal kyi As Integer, ByVal kyf As Integer) Dim i As Integer Dim ix As Integer Dim xx As Double Dim wv As Double Dim str As String Dim kxx As Integer Dim TextSize1 As New System.Drawing.SizeF '普通x軸描画 ix = CInt((xmax - xmin) / dx) For i = 0 To ix xx = xmin + CDbl(i) * dx kxx = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) wv = xmin + CDbl(i) * dx str = wv.ToString("0") If CInt(dx * 1000.0) Mod 10 <> 0 Then str = wv.ToString("0.000") If CInt(dx * 1000.0) Mod 10 = 0 And CInt(dx * 100.0) Mod 10 <> 0 Then str = wv.ToString("0.00") If (CInt(dx * 1000.0) Mod 10 = 0 And CInt(dx * 100.0) Mod 10 = 0) And CInt(dx * 10.0) Mod 10 <> 0 Then str = wv.ToString("0.0") TextSize1 = g.MeasureString(str, f) g.DrawLine(LPen, kxx, kyi, kxx, kyf) g.DrawString(str, f, Brushes.Black, kxx - TextSize1.Width / 2, kyf + kpt * 3) Next i End Sub Private Sub DRN_YJIKU(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal LPen As System.Drawing.Pen, _ ByVal kpt As Integer, _ ByVal ymin As Double, ByVal ymax As Double, ByVal dy As Double, _ ByVal kxi As Integer, ByVal kxf As Integer, _ ByVal kyi As Integer, ByVal kyf As Integer) Dim i As Integer Dim iy As Integer Dim yy As Double Dim wv As Double Dim str As String Dim kyy As Integer Dim TextSize1 As New System.Drawing.SizeF '普通y軸描画 iy = CInt((ymax - ymin) / dy) For i = 0 To iy yy = ymin + CDbl(i) * dy kyy = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) wv = ymin + CDbl(i) * dy str = wv.ToString("0") If CInt(dy * 1000.0) Mod 10 <> 0 Then str = wv.ToString("0.000") If CInt(dy * 1000.0) Mod 10 = 0 And CInt(dy * 100.0) Mod 10 <> 0 Then str = wv.ToString("0.00") If (CInt(dy * 1000.0) Mod 10 = 0 And CInt(dy * 100.0) Mod 10 = 0) And CInt(dy * 10.0) Mod 10 <> 0 Then str = wv.ToString("0.0") TextSize1 = g.MeasureString(str, f) g.DrawLine(LPen, kxi, kyy, kxf, kyy) g.DrawString(str, f, Brushes.Black, kxi - TextSize1.Width - kpt * 2, kyy - TextSize1.Height / 2) Next i End Sub Private Sub DRL_XJIKU(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal LPen As System.Drawing.Pen, _ ByVal kpt As Integer, _ ByVal xmin As Double, ByVal xmax As Double, _ ByVal kxi As Integer, ByVal kxf As Integer, _ ByVal kyi As Integer, ByVal kyf As Integer) Dim i As Integer Dim j As Integer Dim xx As Double Dim str As String Dim kxx As Integer Dim TextSize1 As New System.Drawing.SizeF '対数x軸描画 For i = CInt(xmin) To CInt(xmax) - 1 For j = 1 To 9 xx = System.Math.Log(CDbl(j) * System.Math.Pow(10.0, CDbl(i))) / System.Math.Log(10.0) kxx = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) g.DrawLine(LPen, kxx, kyi, kxx, kyf) Next j Next i For i = CInt(xmin) To CInt(xmax) xx = CDbl(i) kxx = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) str = CStr(System.Math.Pow(10.0, CDbl(i))) TextSize1 = g.MeasureString(str, f) g.DrawString(str, f, Brushes.Black, kxx - TextSize1.Width / 2, kyf + kpt * 3) Next i End Sub Private Sub DRL_YJIKU(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal LPen As System.Drawing.Pen, _ ByVal kpt As Integer, _ ByVal ymin As Double, ByVal ymax As Double, _ ByVal kxi As Integer, ByVal kxf As Integer, _ ByVal kyi As Integer, ByVal kyf As Integer) Dim i As Integer Dim j As Integer Dim yy As Double Dim str As String Dim kyy As Integer Dim TextSize1 As New System.Drawing.SizeF '対数y軸描画 For i = CInt(ymin) To CInt(ymax) - 1 For j = 1 To 9 yy = System.Math.Log(CDbl(j) * System.Math.Pow(10.0, CDbl(i))) / System.Math.Log(10.0) kyy = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) g.DrawLine(LPen, kxi, kyy, kxf, kyy) Next j Next i For i = CInt(ymin) To CInt(ymax) yy = CDbl(i) kyy = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) str = CStr(System.Math.Pow(10.0, CDbl(i))) TextSize1 = g.MeasureString(str, f) g.DrawString(str, f, Brushes.Black, kxi - TextSize1.Width - kpt * 2, kyy - TextSize1.Height / 2) Next i End Sub Private Sub ERES(ByVal nn As Integer, ByVal dt As Double, ByVal h As Double, ByRef ddy() As Double, ByVal nt As Integer, _ ByRef tk() As Double, ByRef resacc() As Double, ByRef resvel() As Double, ByRef resdis() As Double) '地震応答スペクトル 'nn :加速度時刻歴総数 'dt :時間間隔(入力値) 'h :減衰定数(入力値) 'ddy() :加速度時刻歴(入力値) 'nt :計算周期総数(データ格納0〜nt-1)(入力値) 'tk() :計算周期(入力値) 'resacc():加速度応答スペクトル(計算値) 'resvel():速度応答スペクトル(計算値) 'resdis():変位応答スペクトル(計算値) Dim i As Integer Dim m As Integer '応答最大値(gal,kine,cm) Dim accmax As Double Dim velmax As Double Dim dismax As Double Dim w As Double Dim w2 As Double Dim hw As Double Dim wd As Double Dim wdt As Double Dim e As Double Dim cwdt As Double Dim swdt As Double Dim ss As Double Dim cc As Double Dim s1 As Double Dim c1 As Double Dim s2 As Double Dim c2 As Double Dim s3 As Double Dim c3 As Double Dim A11 As Double Dim A12 As Double Dim A21 As Double Dim A22 As Double Dim B11 As Double Dim B12 As Double Dim B21 As Double Dim B22 As Double Dim dxf As Double Dim xf As Double Dim ddym As Double Dim ddyf As Double Dim x As Double Dim dx As Double Dim ddx As Double Dim pi As Double = Math.PI For i = 0 To nt - 1 w = 2.0 * pi / tk(i) w2 = w * w hw = h * w wd = w * System.Math.Sqrt(1.0 - h * h) wdt = wd * dt e = System.Math.Exp(-hw * dt) cwdt = System.Math.Cos(wdt) swdt = System.Math.Sin(wdt) A11 = e * (cwdt + hw * swdt / wd) A12 = e * swdt / wd A21 = -e * w2 * swdt / wd A22 = e * (cwdt - hw * swdt / wd) ss = -hw * swdt - wd * cwdt cc = -hw * cwdt + wd * swdt s1 = (e * ss + wd) / w2 c1 = (e * cc + hw) / w2 s2 = (e * dt * ss + hw * s1 + wd * c1) / w2 c2 = (e * dt * cc + hw * c1 - wd * s1) / w2 s3 = dt * s1 - s2 c3 = dt * c1 - c2 B11 = -s2 / wdt B12 = -s3 / wdt B21 = (hw * s2 - wd * c2) / wdt B22 = (hw * s3 - wd * c3) / wdt accmax = 2.0 * hw * System.Math.Abs(ddy(0)) * dt velmax = System.Math.Abs(ddy(0)) * dt dismax = 0.0 dxf = -ddy(0) * dt xf = 0.0 For m = 1 To nn - 1 ddym = ddy(m) ddyf = ddy(m - 1) x = A12 * dxf + A11 * xf + B12 * ddym + B11 * ddyf dx = A22 * dxf + A21 * xf + B22 * ddym + B21 * ddyf ddx = -2.0 * hw * dx - w2 * x If (accmax <= System.Math.Abs(ddx)) Then accmax = System.Math.Abs(ddx) If (velmax <= System.Math.Abs(dx)) Then velmax = System.Math.Abs(dx) If (dismax <= System.Math.Abs(x)) Then dismax = System.Math.Abs(x) dxf = dx xf = x Next m resacc(i) = accmax resvel(i) = velmax resdis(i) = dismax Next i End Sub Private Sub IACC(ByVal nn As Integer, ByVal dt As Double, ByRef ddy() As Double, ByRef dy() As Double, ByRef y() As Double, _ ByRef ddymax As Double, ByRef dymax As Double, ByRef ymax As Double) '加速度時刻歴数値積分 'nn:加速度時刻歴データ総数 'dt :時間間隔(入力値) 'ddy() :加速度時刻歴(入力値) 'dy() :速度時刻歴(計算出力) 'y() :変位時刻歴(計算出力値) 'ddymax:加速度最大値(計算出力値) 'dymax :速度最大値(計算出力値) 'ymax :変位最大値(計算出力値) Dim i As Integer ddymax = 0.0 dymax = 0.0 ymax = 0.0 dy(0) = 0.0 y(0) = 0.0 For i = 1 To nn - 1 dy(i) = dy(i - 1) + (ddy(i - 1) + ddy(i)) * dt / 2.0 y(i) = y(i - 1) + dy(i - 1) * dt + (ddy(i - 1) / 3.0 + ddy(i) / 6.0) * dt * dt If (ddymax < System.Math.Abs(ddy(i))) Then ddymax = System.Math.Abs(ddy(i)) If (dymax < System.Math.Abs(dy(i))) Then dymax = System.Math.Abs(dy(i)) If (ymax < System.Math.Abs(y(i))) Then ymax = System.Math.Abs(y(i)) Next i End Sub Private Sub CRAC(ByVal nn As Integer, ByVal dt As Double, ByRef ddy() As Double, ByRef dy() As Double, ByRef y() As Double, _ ByVal ddymax As Double, ByVal dymax As Double, ByVal ymax As Double) '加速度時刻歴基線補正 'nn:加速度時刻歴データ総数 'dt :時間間隔(入力値) 'ddy() :加速度時刻歴(入力値・書換出力値) 'dy() :速度時刻歴(入力値) 'y() :変位時刻歴(入力値) 'ddymax:加速度最大値(入力値) 'dymax :速度最大値(入力値) 'ymax :変位最大値(入力値) Dim i As Integer Dim tt As Double Dim t As Double Dim sum As Double Dim a1 As Double Dim a0 As Double Dim acmax As Double Dim coef As Double tt = CDbl(nn - 1) * dt t = 0.0 For i = 0 To nn - 1 y(i) = y(i) * (3.0 * tt - 2.0 * t) * t * t t = t + dt Next i sum = (y(0) + y(nn - 1)) / 2.0 For i = 1 To nn - 2 sum = sum + y(i) Next i sum = sum * dt a1 = 28.0 / 13.0 / tt / tt * (2.0 * dy(nn - 1) - 15.0 / System.Math.Pow(tt, 5.0) * sum) a0 = dy(nn - 1) / tt - a1 / 2.0 * tt t = 0.0 acmax = 0.0 For i = 0 To nn - 1 ddy(i) = ddy(i) - a0 - a1 * t If (acmax < System.Math.Abs(ddy(i))) Then acmax = System.Math.Abs(ddy(i)) t = t + dt Next i coef = ddymax / acmax For i = 0 To nn - 1 ddy(i) = ddy(i) * coef Next i End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ToolStripLabel1.Text = "時刻歴時間軸:xmin,xmax,dx" ToolStripTextBox1.Text = "0,60,5" ToolStripLabel2.Text = "減衰定数:h" ToolStripTextBox2.Text = "0.05" ToolStripLabel3.Text = "ACC=0 or VEL=1" ToolStripTextBox3.Text = "0" End Sub End Class