計算速度を上げるには？？ (ID:100069)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

はじめまして。 
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

←解決時は質問者本人がここをチェックしてください。

戻る