| 查看: 2804 | 回复: 15 | |||
| 本帖产生 2 个 程序强帖 ，点击这里进行查看 | |||
| 当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖 | |||
liangzidou银虫 (小有名气)
|
[交流]
【求助】求助：vb编程中用牛顿迭代解三次方程为什么只得到一个根？【已完成】 已有5人参与
|
||
|
我在用vb编写中，遇到这样一个问题，解一个一元三次方程只得到一个根，实际上不只一个根。请各位高手帮忙找一下错误。 Private Sub Command1_Click() Dim r, p, t, w, pc, tc, m, a, b, ca, cb, xl, xm, xn As Double r = 8.314 p = 101.325 t = 301 pc = 3384 tc = 460.4 w = 0.227 m = 0.37464 + 1.5422 * w + 0.2699 * w ^ 2 tr = t / tc a = 0.45723553 * r ^ 2 * tc ^ 2 * (1 + m * (1 - Sqr(tr))) ^ 2 / pc b = 0.077796074 * r * tc / pc Print "a="; a, "b="; b ca = a * p / (r ^ 2 * t ^ 2) cb = b * p / (r * t) xl = cb - 1 xm = -3 * cb ^ 2 - 2 * cb + ca xn = cb ^ 3 + cb ^ 2 - ca * cb Print "A="; ca, "B="; cb Print "xl="; xl, "xm="; xm Print "xn="; xn Dim f, z As Single z = 0.01 Do z = z1 f = z ^ 3 + xl * z ^ 2 + xm * z + xn f1 = 3 * z ^ 2 + 2 * xl * z + xm z1 = z - f / f1 Loop While Abs(z - z1) >= 0.0005 Print z1 End Sub [ Last edited by liangzidou on 2010-5-15 at 22:22 ] |
回复此楼» 猜你喜欢
明天应该可查了！？
已经有5人回复
-
如果此刻你正在为国基感到焦虑，不妨来听听这首《基金之外》
已经有7人回复
-
没有任何消息-是不是就凉了
已经有8人回复
-
售SCI-T0P文章，我:8O.5.5.1.O.54,科目齐全,可+急
已经有3人回复
-
售SCI一区文章，我:8.O.551.O.5.4,科目全,可伽急
已经有5人回复
-
人气不行了
已经有10人回复
-
我面上完蛋了
已经有10人回复
-
能否退出参与的面上项目解除限项
已经有24人回复
-
filecode，4个jtjc了
已经有17人回复
-
2026国自然函评费到账
已经有19人回复
» 本主题相关价值贴推荐，对您同样有帮助:
- 博后能申请到牛顿申请奖学金
已经有13人回复
- 牛顿-爱因斯坦永动机机理方面的研究能获得自然科学基金资助吗
已经有7人回复
- 【求助】用牛顿环测量球面的曲率半径
已经有3人回复
- 【求助】求一个用牛顿迭代法解非线性方程组的程序
已经有10人回复
7楼2010-04-21 10:24:35
liangzidou
银虫 (小有名气)
- 应助: 1 (幼儿园)
- 金币: 371
- 红花: 1
- 帖子: 68
- 在线: 15.8小时
- 虫号: 720428
- 注册: 2009-03-11
- 性别: GG
- 专业: 能源化工
jjdg:把方程具体的值给出来 2010-04-20 12:52
|
方程就是f = z ^ 3 + xl * z ^ 2 + xm * z + xn=0 其中xl,xm,xn分别是方程的二次项、一次项系数及常数项。 下面这段程序就是我用迭代法就该方程的程序： Dim f, z As Single z = 0.01 Do z = z1 f = z ^ 3 + xl * z ^ 2 + xm * z + xn f1 = 3 * z ^ 2 + 2 * xl * z + xm z1 = z - f / f1 Loop While Abs(z - z1) >= 0.0005 Print z1 最后得到的结果只有一个根。 |
2楼2010-04-20 10:05:18
3楼2010-04-20 12:29:43
|
我用盛金公式 写的 Private Sub Command1_Click() Dim a, b, c, d, aa, bb, cc, delta, y1, y2, k, theta, t, x, x1, x2, x3, tt, tt1, xx2, xx3,s 'az^3+bz^2+cz+d=0，a、b、c、d来自一个例子（见最后） a = 1 b = -70.5 c = 1533.54 d = -10082.44 aa = Round((b ^ 2 - 3 * a * c), 4) bb = Round((b * c - 9 * a * d), 4) cc = Round((c * c - 3 * b * d), 4) delta = Round((bb * bb - 4 * aa * cc), 4) If (aa = 0) And (bb = 0) Then x = -b / (3 * a) Label1.Caption = "X1=X2=X3=:" & x Else Select Case delta Case Is > 0 y1 = aa * b + 3 * a * (-bb + Sqr(delta)) / 2 If y1 > 0 Then y1 = y1 ^ (1 / 3) Else y1 = y1 * (-1) y1 = y1 ^ (1 / 3) * (-1) End If y2 = aa * b + 3 * a * (-bb - Sqr(delta)) / 2 If y2 > 0 Then y2 = y2 ^ (1 / 3) Else y2 = y2 * (-1) y2 = y2 ^ (1 / 3) * (-1) End If tt = y1 + y2 tt1 = 3 ^ (1 / 3) * (y1 - y2) / (6 * a) s = (-2 * b + tt) / (6 * a) x1 = (-b - tt) / (3 * a) x2 = s & "+" & tt1 & "i" x3 = s & "-" & tt1 & "i" Label1.Caption = "X1=" & x1 Label2.Caption = "X2=" & x2 Label3.Caption = "X3=" & x3 Case Is = 0 k = bb / aa x1 = -b / a + k x = Str(-k / 2) Label1.Caption = "X1=" & x1 Label2.Caption = "X2=" & x Label3.Caption = "X3=" & x Case Is < 0 t = (2 * aa * b - 3 * a * bb) / (2 * aa ^ (3 / 2)) theta = Atn(-t / Sqr(-t * t + 1)) + 2 * Atn(1) theta = theta / 3 tt = aa ^ (1 / 2) * Cos(theta) tt1 = 3 ^ (1 / 2) * Sin(theta) x1 = (-b - 2 * tt) / (3 * a) xx2 = (-b + tt + tt1) / (3 * a) xx3 = (-b + tt - tt1) / (3 * a) Label1.Caption = "X1=" & x1 Label2.Caption = "X2=" & xx2 Label3.Caption = "X3=" & xx3 End Select End If End Sub 一建筑物的楼顶要建一个储水池，按施工的设计要求，这个储水池的长、宽、高之和为67.4dm，且宽=高，满储水量为9539.712(dm)＾3，立体对角线为1706.92dm，问：如何施工才能达到设计要求？ 解：设取长、宽、高分别为X⑴、X⑵、X⑶，依题意： X⑴＋X⑵＋X⑶=67.4； X⑴X⑵X⑶=9539.712； X⑴^2＋X⑵^2＋X⑶^2=1706.92。 解这个方程组，得一元三次方程 X＾3－67.4X＾2＋1417.92X－9539.712=0 a=1，b=－67.4，c=1417.92，d=－9539.712。 A=289；B=－9710.4；C=81567.36， Δ=0。 根据盛金判别法，此方程有三个实根，其中两个相等。 应用盛金公式③求解。 K=—33.6。 把有关值代入盛金公式③，得： X⑴=33.8(dm)；X⑵=X⑶=16.8(dm)。 经检验，结果正确。 因为宽=高， 所以，应取长为33.8dm；宽=高=16.8dm来进行施工。 [ Last edited by jjdg on 2010-4-20 at 14:20 ] |
4楼2010-04-20 14:18:56
20