24小时热门版块排行榜

>论坛更新日志 (4371)
>虫友互识 (575)
>导师招生 (468)
>找工作 (288)
>文献求助 (271)
>职场人生 (243)
>论文投稿 (243)
>考博 (145)
>休闲灌水 (114)
>考研 (105)
>博后之家 (85)
>硕博家园 (78)
>学术会议 (73)
>招聘信息布告栏 (65)
>医学 (61)
>有机交流 (31)

返回列表

飞扬123

新虫 (初入文坛)

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

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

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

回复此楼

» 猜你喜欢

关于核磁制样已经有3人回复
郑州大学申博已经有6人回复
CsPbI2Br全无机钙钛矿SEM图像异常分析已经有8人回复

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

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

snoopyzhao

至尊木虫 (职业作家)

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

赞一下

回复此楼

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

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

gsview

木虫 (小有名气)

应助: 4 (幼儿园)
金币: 2406.9
帖子: 146
在线: 234.8小时
虫号: 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的回帖