Function u(t) As Double
u = 10 ^ 10.741 / t ^ 4.512
End Function
 Function t(L) As Double
 t = 824.31 * 3.23 * (1 - Exp(-2.54 * (1680 - L) / 824.31)) / (100 * 2.54) + (85.2 - 3.23 * (1680 - L) / 100)
 End Function
Private Sub Form_Click()
Dim dh, H0, H1, m, fti, fp, fr, mh, Wl0, Wl, Hm, Lm, Wr1, wr, Iu, Id, Fu, Fd, Frl, Hhalf As Double
Dim dr(), σ1()
Dim Le(0 To 3) As Single
Dim pmax, pmin, dpmax, dpmin, σmax, σc, e, σa As Double
Dim i, k As Integer
dti = 88.9
miduave = 945
fti = 3.14 * (dti * 10 ^ (-3)) ^ 2 / 4
fp = 3.14 * (Text18 * 10 ^ (-3)) ^ 2 / 4
Wl0 = (fp - (25.3 * 10 ^ (-3)) ^ 2 * 3.14 / 4) * miduave * 9.8 * 220
dr = Array(19, 22, 25, 29)
σ1 = Array(100 * 10 ^ 6, 120 * 10 ^ 6, 150 * 10 ^ 6, 180 * 10 ^ 6)
Hhalf = 1680 / 2
H0 = Hhalf - 1333
Do
pmax = 1717: pmin = -1717
dh = 100
i = 0
For k = 0 To 3
Le(k) = 0
Next k
Do
Do
If i < 4 Then

H1 = H0 + dh
If H1 > Hhalf Then
H1 = Hhalf: dh = H1 - H0
End If
Hm = H0 + dh / 2: Lm = Hhalf - Hm
m = dti / dr(i)
fr = 3.14 * (dr(i) * 10 ^ (-3)) ^ 2 / 4
e = (fp - fr) / (fti - fr)
mh = (m ^ 2 - 1) / ((m ^ 2 + 1) * Log(m) - (m * m - 1))
Frl = 2 * 3.14 * u(t(Lm)) * mh * (3.14 * 6 * 3 / 60) / 10 ^ 3
wr = 7850 * 9.8 * fr * dh
Wr1 = (7850 - miduave) * 9.8 * fr * dh
Fu = 0.015 * wr + Frl / 1.3
Fd = 0.015 * wr + Frl
Iu = wr * 3 * 6 ^ 2 * (1 + 1 / 4) * (1 + e) / 1790
Id = wr * 3 * 6 ^ 2 * (1 - 1 / 4) / 1790
dpmax = Wr1 + Fu + Iu
dpmin = Wr1 - Id - Fd
pmax = pmax + dpmax
pmin = pmin + dpmin
σa = (pmax - pmin) / fr
σmax = pmax / fr
                               σc = Sqr(σa - σmax)‘  这段语句开始出现问题，显示无效的过程。。
Print σc
If σc > σ1(i) Then
i = i + 1: pmax = pmax - dpmax: pmin = pmin - dpmin
End If
 End If
Loop While σc > σ1(i)
Le(i) = Le(i) + dh
Wl = Wl + miduave * 9.8 * dh * (fp - fr)
H0 = H1
Loop While H1 < Hhalf
If Abs(Wl0 - Wl) > 0.01 Then
H0 = Hhalf - Lmax
End If
Loop While Abs(Wl0 - Wl) > 0.01
For k = 0 To 3
Print Le(k)
Next k
End Sub