はじめまして。
VB6.0を使用してプログラムを作成しているんですが、このプログラム、計算にすごく時間がかかります。。
僕のパソコンでは3時間近くかかってしまうんです。
それで、どうにか計算条件や結果に影響がないようにこのプログラムの処理速度を上げることができればいいなと思うのですが、どうしたらいいのかわかりません。
2005にアップグレードするという方法もあるのですが、このプログラムで計算された結果を別のVB6.0で作成されたプログラムでさらに解析をすすめないといけないので、これだけアップグレードすることは少し都合が悪いんです。
もう少し時間に余裕があれば、その方法を使いたいところなのですが。。。
もしいい方法があれば何かアドバイスお願いします。
プログラムをはりつけますが、非常に長いので申し訳ありません。。
Private Sub mnuSave_Click()
Form1.Hide
Form2.Show
End Sub
Private Sub mnuPrint_Click()
Form1.Hide
Form3.Show
End Sub
Private Sub Form_Load()
Form1.Top = 0
Form1.Left = Screen.Width * 0.18
Form1.Width = Screen.Width * 0.8
Form1.Height = Screen.Height * 0.8
On Error Resume Next
CD = Left$(CurDir, 1)
CD = CD + ":\AAA"
Err.Number = 0
MkDir CD
If Err.Number <> 0 Then GoTo FILECHK
FILECHK:
FDAMMY = CD + "\DAMMY"
Open FDAMMY For Output As #1
Write #1, "ZZZ"
Close #1
End Sub
Private Sub mnuCalc_Click()
Dim nang(10000, 100), tnang(10000) As Variant
Dim sang(10000, 100), tsang(10000) As Variant
Dim chk(100, 100), nchk(100, 100) As Variant
Dim crtn, rnys, rnwd, xnmz As String
Dim tn As Variant
Dim mlm As Variant
Print "ただいま計算中です"
emin = 1 * 10 ^ -50
pi = 3.141592654
rtd = 180 / pi
tn = 0
For i = 1 To 1100
tnang(i) = 0
tsang(i) = 0
For j = 1 To 20
nang(i, j) = 0
sang(i, j) = 0
Next j
Next i
''''''''''''''' 初期データ読込 '''''''''''''''
CD = Left$(CurDir, 1)
CD = CD + ":\AAA"
Open CD + "\inidata.dat" For Input As #1
Input #1, sxxo, syyo, sxyo, aspc
Input #1, lmax, mmax, nmax, mlm
Input #1, xcrtn, nssc
Input #1, srnyn, srnwd, srnmz
Input #1, drnyn, drnwd, drnmz
Close #1
ntsbd = lmax * mmax * nmax
For i = 1 To mmax + 2
For j = 1 To nmax + 2
chk(i, j) = 0
Next j
Next i
If mlm = 0 Then
GoTo CALSTRT:
Else
freq = 1
Do Until freq = mmax * nmax * mlm
chk(Int(Rnd * (mmax + 1)) + 1, Int(Rnd * (nmax + 1)) + 1) = 1
freq = freq + 1
Loop
End If
''''''''''''''' 方 位 計 算 '''''''''''''''
CALSTRT:
'' 応力＆粒径一定の場合
sxx = sxxo
syy = syyo
sxy = sxyo
dgs = 1
''''' 面方位＆すべり方位 '''''
SLPDIR:
For L = 1 To (lmax + 1)
angl = 2 * pi * (L - 1) / lmax
' angl = -pi + 2 * pi * (L - 1) / lmax
' angl = -pi / 2 + pi * (L - 1) / lmax
ta = Tan(angl)
For M = 1 To (mmax + 1)
angm = -pi / 2 + pi * (M - 1) / mmax
' angm = 2 * pi * (M - 1) / mmax
' angm = -pi + 2 * pi * (M - 1) / mmax
' angm = pi * (M - 1) / mmax
If Abs(ta) < emin Then GoTo TANG0
lya = (1 / ta) / Sqr(1 + 1 / ta ^ 2) * Cos(angm)
lxa = -lya * ta
GoTo RELXB
TANG0:
lxa = 0
If ta > 0 Then lya = Cos(angm) Else lya = -Cos(angm)
RELXB:
For N = 1 To (nmax + 1)
angn = 2 * pi * (N - 1) / nmax
' angn = -pi + 2 * pi * (N - 1) / nmax
' angn = pi * (N - 1) / nmax
lxb = Sqr(1 - lxa ^ 2) * Cos(angn)
If Abs(lxb) < emin Then GoTo NUMBANG
C = (lxa * lya / lxb) ^ 2 + lya ^ 2 - 1
P = 1 - lxa ^ 2 - lxb ^ 2
If P < 0 Then GoTo NUMBANG
For i = 1 To 2
''''' lxc1の場合 '''''
If i = 1 Then lxc = Sqr(P)
''''' lxc2の場合 '''''
If i = 2 Then lxc = -Sqr(P)
A = 1 + (lxc / lxb) ^ 2
B = 2 * lxa * lya * lxc / (lxb ^ 2)
Q = B ^ 2 - 4 * A * C
If Q < 0 Then GoTo NUMBANG
''''' 2根のチェック '''''
For j = 1 To 2
''''' lyc プ ラ ス '''''
If j = 1 Then lyc = (-B + Sqr(Q)) / (2 * A)
''''' lyc マイナス '''''
If j = 2 Then lyc = (-B - Sqr(Q)) / (2 * A)
R = 1 - (lya ^ 2 + lyc ^ 2)
If R < 0 Then GoTo NUMBANG
For K = 1 To 2
''''' lyb プ ラ ス '''''
If K = 1 Then lyb = Sqr(R)
''''' lyb マイナス '''''
If K = 2 Then lyb = -Sqr(R)
d = lxa * lya + lxb * lyb + lxc * lyc
If Abs(d) < emin Then GoTo CALCSTR Else GoTo NUMBANG
''''''''''''''' すべり面内応力＆すべり角度の計算 '''''''''''''''
''''' 結晶粒毎の負荷応力の計算 '''''
CALCSTR:
If srnyn = 0 Then GoTo CALCDGS
'' 応力乱数化
STRRAND:
If srnmz = 0 Then GoTo SNONRNDMZ
Randomize
SNONRNDMZ:
If srnwd = 1 Then GoTo SRNDWDTH1
'' 変動範囲 0.0〜2.0
snr = 2
srndmin = 0
GoTo SRNDWDTH2
'' 変動範囲 0.5〜1.5
SRNDWDTH1:
snr = 1
srndmin = 0.5
SRNDWDTH2:
sxx = sxxo * (Rnd(1) + srndmin) * snr
syy = syyo * (Rnd(1) + srndmin) * snr
sxy = sxyo * (Rnd(1) + srndmin) * snr
''''' 結晶粒毎の結晶粒径の計算 '''''
CALCDGS:
If drnyn = 0 Then GoTo SLPSTR
'' 結晶粒径乱数化
DTRRAND:
If drnmz = 0 Then GoTo DNONRNDMZ
Randomize
DNONRNDMZ:
If drnwd = 1 Then GoTo DRNDWDTH1
'' 変動範囲 0.0〜2.0
dnr = 2
drndmin = 0
GoTo DRNDWDTH2
'' 変動範囲 0.5〜1.5
DRNDWDTH1:
dnr = 1
drndmin = 0.5
DRNDWDTH2:
dgs = (Rnd(1) + drndmin) * dnr
''''' 結晶粒毎のすべり面上応力の計算 '''''
SLPSTR:
''''' 分解せん断応力
rss = sxx * lxa * lya + syy * lxb * lyb
rss = rss + sxy * (lxa * lyb + lxb * lya)
If xcrtn = 0 Then GoTo NSSNEGL
''''' 垂直応力の計算とき裂発生の判定
nss = sxx * lxa ^ 2 + syy * lxb ^ 2
nss = nss + 2 * sxy * lxa * lxb
If nss > nssc And Abs(rss) > 1 Then ngc = 1 Else ngc = 0
GoTo CALANGL
''''' き裂発生の判定
NSSNEGL:
If Abs(rss) > 1 Then ngc = 1 Else ngc = 0
CALANGL:
If ngc = 0 Then GoTo NUMBANG
angd = angl * rtd
If angd < -90 Then angd = angd + 180
If angd > 90 Then angd = angd - 180
''''' 発生寿命の計算
sd = aspc / Sqr((aspc * Cos(angl)) ^ 2 + (Sin(angl)) ^ 2)
ncci = 220 / sd / (Abs(rss) / 108 - 1) ^ 2
alp = angd / rtd
''''' すべり強度の計算
tn = tn + 1
sl = Sqr(1 - (lxb ^ 2 + lyb ^ 2)) * sd
''''' 発生寿命毎の角度分布(10deg間隔の累積数)
For U = 1 To 1000
If ncci > 10 * U Then GoTo EANGJMP
For V = 1 To 18
If angd >= (-90 + (V - 1) * 10) And angd < (-90 + V * 10) Then nang(U, V) = nang(U, V) + 1
If angd >= (-90 + (V - 1) * 10) And angd < (-90 + V * 10) Then sang(U, V) = sang(U, V) + sl
Next V
EANGJMP:
Next U
Next K
Next j
Next i
NUMBANG:
Next N
Next M
RL = L / lmax
If RL = 0.1 Then Print " １０％ 完了"
If RL = 0.2 Then Print " ２０％ 完了"
If RL = 0.3 Then Print " ３０％ 完了"
If RL = 0.4 Then Print " ４０％ 完了"
If RL = 0.5 Then Print " ５０％ 完了"
If RL = 0.6 Then Print " ６０％ 完了"
If RL = 0.7 Then Print " ７０％ 完了"
If RL = 0.8 Then Print " ８０％ 完了"
If RL = 0.9 Then Print " ９０％ 完了"
Next L
Cls
Beep
For i = 1 To 1000
For j = 1 To 18
tnang(i) = tnang(i) + nang(i, j)
tsang(i) = tsang(i) + sang(i, j)
Next j
Next i
For i = 1 To 1000
If tnang(i) = 0 Or tsang(i) = 0 Then GoTo NANGJMP
For j = 1 To 18
nang(i, j) = nang(i, j) * 100 / tnang(i)
sang(i, j) = sang(i, j) * 100 / tsang(i)
Next j
NANGJMP:
Next i
''''''''''''''' データ仮保存 '''''''''''''''
Pout:
CD = Left$(CurDir, 1)
CD = CD + ":\AAA"
dfile = CD + "\result.dat"
Open dfile For Output As #1
Write #1, sxxo, syyo, sxyo, aspc
Write #1, ntsbd, xcrtn, nssc, mlm, tn
Write #1, srnyn, srnwd, srnmz
Write #1, drnyn, drnwd, drnmz
For i = 1 To 1000
Write #1, tnang(i), tsang(i)
For j = 1 To 18
Write #1, nang(i, j), sang(i, j)
Next j
Next i
Close #1
dspl = InputBox("結果を画面に表示しますか？ はい：Ｙ いいえ：Ｎ", "画面表示", "Y")
If dspl = "Y" Or dspl = "y" Or dspl = "N" Or dspl = "n" Then GoTo DSPLY
YNDSPL1:
dspl = InputBox("再入力して下さい． はい：Ｙ いいえ：Ｎ", "画面表示再入力", "Y")
If dspl = "Y" Or dspl = "y" Or dspl = "N" Or dspl = "n" Then GoTo DSPLY
GoTo YNDSPL1
DSPLY:
Cls
If dspl = "N" Or dspl = "n" Then GoTo ENDCAL
Form1.Hide
Form3.Show
ENDCAL:
End Sub
Private Sub mnuInput_Click()
Dim crtn, ssrnys, ssrnwd, ssxnmz, sdrnys, sdrnwd, sdxnmz As String
On Error Resume Next
CD = Left$(CurDir, 1)
CD = CD + ":\AAA"
Err = 0
Kill CD + "\*.*"
If Err <> 0 Then GoTo FileChk1
FileChk1:
Err = 0
RmDir CD
If Err <> 0 Then GoTo FileChk2
FileChk2:
Err = 0
MkDir CD
If Err <> 0 Then GoTo FileChk3
FileChk3:
''''''''''''''' 初期データ入力 '''''''''''''''
sxxo = InputBox$("σx の値を入力して下さい", "σx の値", "0")
sxxo = Val(sxxo)
syyo = InputBox$("σy の値を入力して下さい", "σy の値", "1200")
syy0 = Val(syyo)
sxyo = InputBox$("τxyの値を入力して下さい", "τxyの値", "0")
sxyo = Val(sxyo)
aspc = InputBox$("結晶アスペクト比Λの値を入力して下さい", "Λの値", "1")
aspc = Val(aspc)
lmax = InputBox$("すべり帯角度[-180〜+180]の分割数を入力して下さい", "分割数", "360")
lmax = Val(lmax)
mmax = InputBox$("すべり面方位角度[-90〜+90]の分割数を入力して下さい", "分割数", "90")
mmax = Val(mmax)
nmax = InputBox$("すべり方向角度[-180〜+180]の分割数を入力して下さい", "分割数", "90")
nmax = Val(nmax)
mlm = InputBox$("介在物の存在比率[0〜1]を入力してください", "存在比率", "0.27")
mlm = Val(mlm)
crtn = InputBox("垂直応力を考慮しますか？ はい：Ｙ いいえ：Ｎ", "き裂発生基準", "N")
If crtn = "Y" Or crtn = "y" Or crtn = "N" Or crtn = "n" Then GoTo DATINP1
YNREINP1:
crtn = InputBox("再入力して下さい． はい：Ｙ いいえ：Ｎ", "き裂発生基準再入力", "N")
If crtn = "Y" Or crtn = "y" Or crtn = "N" Or crtn = "n" Then GoTo DATINP1
GoTo YNREINP1
DATINP1:
If crtn = "Y" Or crtn = "y" Then xcrtn = 1 Else xcrtn = 0
nssc = 0
If xcrtn = 0 Then GoTo SRANDYNC
nssc = InputBox$("垂直応力の値を入力して下さい", "垂直応力の値", "0")
nssc = Val(nssc)
'' 応力のランダム化 ''
SRANDYNC:
ssrnyn = InputBox("応力をランダム化しますか？ はい：Ｙ いいえ：Ｎ", "応力乱数化", "Y")
If ssrnyn = "Y" Or ssrnyn = "y" Or ssrnyn = "N" Or ssrnyn = "n" Then GoTo SRANDINP
SYNREINP2:
ssrnyn = InputBox("再入力して下さい． はい：Ｙ いいえ：Ｎ", "応力乱数化再入力", "Y")
If ssrnyn = "Y" Or ssrnyn = "y" Or ssrnyn = "N" Or ssrnyn = "n" Then GoTo SRANDINP
GoTo SYNREINP2
SRANDINP:
If ssrnyn = "Y" Or ssrnyn = "y" Then srnyn = 1 Else srnyn = 0
If srnyn = 0 Then GoTo SDATINP3
'' 乱数変動幅の設定
ssrnwd = InputBox("乱数変動幅を入力下さい． 0.5〜1.5：Ｓ 0.0〜2.0：Ｌ", "乱数変動幅", "S")
If ssrnwd = "L" Or ssrnwd = "l" Or ssrnwd = "S" Or ssrnwd = "s" Then GoTo SDATINP2
SYNREINP3:
ssrnmz = InputBox("再入力して下さい． 0.5〜1.5：Ｓ 0.0〜2.0：Ｌ", "乱数変動幅", "S")
If ssrnwd = "L" Or ssrnwd = "l" Or ssrnwd = "S" Or ssrnwd = "s" Then GoTo SDATINP2
GoTo SYNREINP3
'' 乱数初期化の有無
SDATINP2:
ssrnmz = InputBox("乱数を初期化しますか？ はい：Ｙ いいえ：Ｎ", "乱数初期化", "Y")
If ssrnmz = "Y" Or ssrnmz = "y" Or ssrnmz = "N" Or ssrnmz = "n" Then GoTo SDATINP3
SYNREINP4:
ssrnmz = InputBox("再入力して下さい． はい：Ｙ いいえ：Ｎ", "乱数初期化再入力", "Y")
If ssrnmz = "Y" Or ssrnmz = "y" Or ssrnmz = "N" Or ssrnmz = "n" Then GoTo SDATINP3
GoTo SYNREINP4
SDATINP3:
If srnyn = 0 Then GoTo DATOUT
If ssrnwd = "S" Or ssrnwd = "s" Then srnwd = 1 Else srnwd = 2
If ssrnmz = "Y" Or ssrnmz = "y" Then srnmz = 1 Else srnmz = 0
'' 粒径のランダム化 ''
DRANDYNC:
sdrnyn = InputBox("粒径をランダム化しますか？ はい：Ｙ いいえ：Ｎ", "粒径乱数化", "N")
If sdrnyn = "Y" Or sdrnyn = "y" Or sdrnyn = "N" Or sdrnyn = "n" Then GoTo DRANDINP
DYNREINP2:
sdrnyn = InputBox("再入力して下さい． はい：Ｙ いいえ：Ｎ", "粒径乱数化再入力", "N")
If drnyn = "Y" Or ssdrnyn = "y" Or sdrnyn = "N" Or sdrnyn = "n" Then GoTo DRANDINP
GoTo DYNREINP2
DRANDINP:
If sdrnyn = "Y" Or sdrnyn = "y" Then drnyn = 1 Else drnyn = 0
If drnyn = 0 Then GoTo DDATINP3
'' 乱数変動幅の設定
sdrnwd = InputBox("乱数変動幅を入力下さい． 0.5〜1.5：Ｓ 0.0〜2.0：Ｌ", "乱数変動幅", "S")
If sdrnwd = "L" Or sdrnwd = "l" Or sdrnwd = "S" Or sdrnwd = "s" Then GoTo DDATINP2
DYNREINP3:
sdrnmz = InputBox("再入力して下さい． 0.5〜1.5：Ｓ 0.0〜2.0：Ｌ", "乱数変動幅", "S")
If sdrnwd = "L" Or sdrnwd = "l" Or sdrnwd = "S" Or sdrnwd = "s" Then GoTo DDATINP2
GoTo DYNREINP3
'' 乱数初期化の有無
DDATINP2:
sdrnmz = InputBox("乱数を初期化しますか？ はい：Ｙ いいえ：Ｎ", "乱数初期化", "N")
If sdrnmz = "Y" Or sdrnmz = "y" Or sdrnmz = "N" Or sdrnmz = "n" Then GoTo DDATINP3
DYNREINP4:
sdrnmz = InputBox("再入力して下さい． はい：Ｙ いいえ：Ｎ", "乱数初期化再入力", "N")
If sdrnmz = "Y" Or sdrnmz = "y" Or sdrnmz = "N" Or sdrnmz = "n" Then GoTo DDATINP3
GoTo DYNREINP4
DDATINP3:
If drnyn = 0 Then GoTo DATOUT
If sdrnwd = "S" Or sdrnwd = "s" Then drnwd = 1 Else drnwd = 2
If sdrnmz = "Y" Or sdrnmz = "y" Then drnmz = 1 Else drnmz = 0
''''''''''''''' 初期データ保存 '''''''''''''''
DATOUT:
CD = Left$(CurDir, 1)
CD = CD + ":\AAA"
Open CD + "\inidata.dat" For Output As #1
Write #1, sxxo, syyo, sxyo, aspc
Write #1, lmax, mmax, nmax, mlm
Write #1, xcrtn, nssc
Write #1, srnyn, srnwd, srnmz
Write #1, drnyn, drnwd, drnmz
Close #1
End Sub
Private Sub mnuXend_Click()
On Error Resume Next
CD = Left$(CurDir, 1)
CD = CD + ":\AAA"
Err.Number = 0
Kill CD + "\*.*"
If Err.Number <> 0 Then GoTo END1
END1:
Err.Number = 0
RmDir CD
If Err.Number <> 0 Then GoTo END2
END2:
End
End Sub
この長いソースを読んで解析してアルゴリズムを修正しろ、と
これはもうある種の暴力なんじゃないかと思うわけだけども。
ナニ計算してるのか知らないけど、パっと見ただけでも処理速度云々とは関係無さそうな処理が含まれてるよね。
とりあえずステップ実行で実際にどの処理にどんだけ時間がかかってるのか位まとめてくんろ。
#何重ものループに散りばめられたGOTO文
#イチから構築しなおした方が早いかもねｗ
mixiのコミュニティーにも同じプログラムの投稿がありました。
プログラム見た瞬間、拒絶反応示しまたよ・・・
mixi内では親切に回答されている方々もいましたが・・・
速度を求めるなら、こういう計算式はＣ言語で作成した方がいいと思うよ。アルゴリズムができているのならあとはＣ言語風に書き直すだけでしょ。(for文とIf文さえ注意すればいけるはず。)
ソースみて気になったとこは、Variantを使用しないでsingleなりdoubleなりを使用したほうがいい。速度に影響するかは分からないけどね。
あと、関数化した方が見やすいよ。
速度的に改善できそうなのは
>If angd >= (-90 + (V - 1) * 10) And angd < (-90 + V * 10) Then nang(U, V) = nang(U, V) + 1
>
の (-90 + (V - 1) * 10), (-90 + V * 10) 部分は初期化部分で先に計算して配列にでも詰めておけば多少早くなるよ。
同じ比較が上下で行われているのには訳があるのかな？
Randomizeを何回も行っているようだけどプログラム起動時に一回やるだけで十分な気がする。