24小时热门版块排行榜

返回列表

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

飞扬123

新虫 (初入文坛)

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

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

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

回复此楼

» 猜你喜欢

上海工程技术大学张培磊教授团队招收博士生已经有3人回复
上海工程技术大学【激光智能制造】课题组招收硕士已经有5人回复
求助院士们，这个如何合成呀已经有4人回复
临港实验室与上科大联培博士招生1名已经有9人回复
想换工作。大多数高校都是评职称时认可5年内在原单位取得的成果吗？已经有7人回复
需要合成515-64-0，50g，能接单的留言已经有4人回复
自荐读博已经有4人回复
写了一篇“相变储能技术在冷库中应用”的论文，论文内容以实验为主，投什么期刊合适？已经有6人回复
带资进组求博导收留已经有10人回复
最近几年招的学生写论文不引自己组发的文章已经有11人回复

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

需要用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的回帖

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