版块导航: 正在加载中...

登录注册

应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜

返回列表

当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

飞扬123

新虫 (初入文坛)

应助: 0 (幼儿园)
金币: 301.6
帖子: 3
在线: 46分钟
虫号: 1151311

[交流] 【求助】急需一个程序

急需：一个求解一元多次方程的Fortran程序，谢谢！

回复此楼

» 猜你喜欢

2025冷门绝学什么时候出结果已经有3人回复
天津工业大学郑柳春团队欢迎化学化工、高分子化学或有机合成方向的博士生和硕士生加入已经有4人回复
康复大学泰山学者周祺惠团队招收博士研究生已经有6人回复
AI论文写作工具：是科研加速器还是学术作弊器？已经有3人回复
孩子确诊有中度注意力缺陷已经有6人回复
2026博士申请-功能高分子，水凝胶方向已经有6人回复
论文投稿，期刊推荐已经有4人回复
硕士和导师闹得不愉快已经有13人回复
请问2026国家基金面上项目会启动申2停1吗已经有5人回复
同一篇文章，用不同账号投稿对编辑决定是否送审有没有影响？已经有3人回复

» 本主题相关价值贴推荐，对您同样有帮助:

需要用matlab拟合数据的外行人急需帮助已经有10人回复
MATLAB 编程求解普通实验数据时间序列的最大李雅普诺夫指数！！！已经有12人回复
两本经典的入门教程C Primer plus（第五版）和C++ Primer plus（第五版）已经有58人回复
求助~~!!请懂SQL SERVER的进. 已经有13人回复
【求助】急需最新全国行政区划数据和常见汉字及其拼音（也可以是声母的第一个字母）数已经有4人回复
【求助】用matlab编程，需要将数据自检分类（高手进来指点下）已经有5人回复
【求助】购买程序降温的烘箱求助！！已经有11人回复
【讨论】哪位有VB6.0英文版啊，急需【已完成】已经有3人回复
【分享】Origin 8.x 视频教程（75个）已经有177人回复

» 抢金币啦！回帖就可以得到:
查看全部散金贴

1楼2010-11-30 09:57:33

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

553宿舍

新虫 (初入文坛)

应助: 0 (幼儿园)
金币: 74.5
帖子: 25
在线: 9.8小时
虫号: 1002314

呵呵，挺有意思的！

回复此楼

6楼2010-12-02 16:44:06

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

查看全部 9 个回答

snoopyzhao

至尊木虫 (职业作家)

自已写，或找现成的软件做……

赞一下

回复此楼

2楼2010-11-30 10:05:25

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

gsview

木虫 (小有名气)

应助: 4 (幼儿园)
金币: 2446.9
帖子: 146
在线: 233.6小时
虫号: 443276

★
余泽成(金币+1):谢谢参与应助，欢迎常来程序语言版！ 2010-12-24 16:15:28

从书上给你找的！

DIMENSION A(4,4),B(4),X(4),JS(4)
DOUBLE PRECISION A,B,X
DATA A/0.2368,0.1968,0.1582,1.1161,0.2471,0.2071,1.1675,0.1254
   *    ,0.2568,1.2168,0.1768,0.1397,1.2671,0.2271,0.1871,0.1490/
DATA B/1.8471,1.7471,1.6471,1.5471/
N=4
CALL AGAUS(A,B,N,X,L,JS)
IF (L.NE.0) THEN
   WRITE(*,10) (I,X(I),I=1,4)
END IF
10 FORMAT(1X,'X(',I2,' )=',D15.6)
END

SUBROUTINE AGAUS(A,B,N,X,L,JS)
DIMENSION A(N,N),X(N),B(N),JS(N)
DOUBLE PRECISION A,B,X,T
L=1
DO 50 K=1,N-1
   D=0.0
   DO 210 I=K,N
   DO 210 J=K,N
      IF (ABS(A(I,J)).GT.D) THEN
      D=ABS(A(I,J))
      JS(K)=J
      IS=I
      END IF
210    CONTINUE
   IF (D+1.0.EQ.1.0) THEN
      L=0
   ELSE
      IF (JS(K).NE.K) THEN
      DO 220 I=1,N
         T=A(I,K)
         A(I,K)=A(I,JS(K))
         A(I,JS(K))=T
220       CONTINUE
      END IF
      IF (IS.NE.K) THEN
      DO 230 J=K,N
         T=A(K,J)
         A(K,J)=A(IS,J)
         A(IS,J)=T
230       CONTINUE
      T=B(K)
      B(K)=B(IS)
      B(IS)=T
      END IF
   END IF
   IF (L.EQ.0) THEN
      WRITE(*,100)
      RETURN
   END IF
   DO 10 J=K+1,N
      A(K,J)=A(K,J)/A(K,K)
10    CONTINUE
   B(K)=B(K)/A(K,K)
   DO 30 I=K+1,N
      DO 20 J=K+1,N
      A(I,J)=A(I,J)-A(I,K)*A(K,J)
20       CONTINUE
      B(I)=B(I)-A(I,K)*B(K)
30    CONTINUE
50 CONTINUE
IF (ABS(A(N,N))+1.0.EQ.1.0) THEN
   L=0
   WRITE(*,100)
   RETURN
END IF
X(N)=B(N)/A(N,N)
DO 70 I=N-1,1,-1
   T=0.0
   DO 60 J=I+1,N
      T=T+A(I,J)*X(J)
60    CONTINUE
   X(I)=B(I)-T
70 CONTINUE
100 FORMAT(1X,' FAIL ')
JS(N)=N
DO 150 K=N,1,-1
   IF (JS(K).NE.K) THEN
      T=X(K)
      X(K)=X(JS(K))
      X(JS(K))=T
   END IF
150 CONTINUE
RETURN
END

赞一下(1人)

回复此楼

3楼2010-11-30 16:41:18

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖