當(dāng)前只顯示滿足指定條件的回帖，點(diǎn)擊這里查看本話題的所有回帖

zyj8119

木蟲 (著名寫手)

應(yīng)助: 65 (初中生)
貴賓: 0.003
金幣: 915.1
散金: 1440
紅花: 35
帖子: 2936
在線: 1329.4小時
蟲號: 664177
注冊: 2008-11-29
性別: GG
專業(yè): 理論和計(jì)算化學(xué)

[求助] 一個FORTRAN90程序，越界了，希望高手幫助

CODE:

module inv_mat

contains

subroutine inv(A,invA,N)

implicit real*8(a-z)

integer::n

integer::i

real*8::A(n,n),invA(n,n),E(n,n)

E=0

do i=1,n

   E(i,i)=1

end do

call mateq(A,B,X,N,N)

end subroutine inv

subroutine mateq(A,B,X,N,M)

implicit real*8(a-z)

integer::N,M,i

real*8::A(M,N),B(N,M),X(N,M)

real*8::btemp(N),xtemp(N)

do i=1,M

   btemp=B(:,i)

   call elgauss(A,btemp,xtemp,N)

   X(:,i)=xtemp

end do

end subroutine mateq

subroutine elgauss(A,b,x,N)

implicit real*8(a-z)

integer::i,k,N

integer::id_max

real*8::A(N,N),b(N),x(N)

real*8::Aup(N,N),bup(N)

real*8::Ab(N,N+1)

real*8::vtemp1(N+1),vtemp2(N+1)

Ab(1:N,1:N)=A

Ab(:,N+1)=b

do k=1,N-1

   elmax=dabs(Ab(k,k))

   id_max=k

   do i=k+1,n

    if(dabs(Ab(i,k))>elmax)then

        elmax=Ab(i,k)

        id_max=i

        end if

        end do

        vtemp1=Ab(k,:)

        vtemp2=Ab(id_max,:)

        Ab(k,:)=vtemp2

        Ab(id_max,:)=vtemp1

 do i=k+1,N

    temp=Ab(i,k)/Ab(k,k)

        Ab(i,:)=Ab(i,:)-temp*Ab(k,:)

 end do

end do

Aup(:,:)=Ab(1:N,1:N)

bup(:)=Ab(:,N+1)

call uptri(Aup,bup,x,n)

end subroutine elgauss

subroutine uptri(A,b,x,N)

implicit real*8(a-z)

integer::i,j,N

real*8::A(N,N),b(N),x(N)

x(N)=b(N)/A(N,N)

do i=n-1,1,-1

    x(i)=b(i)

        do j=i+1,N

        x(i)=x(i)-a(i,j)*x(j)

        end do

        x(i)=x(i)/A(i,i)

end do

end subroutine uptri

end module inv_mat

module m_bfs

use inv_mat

contains

subroutine solve(x0,N,tol)

implicit real*8(a-z)

integer::i,n,itmax=50

real*8::x1(n),x0(n),y(n),f0(n),f1(n),dx(n)

real*8::v1(n),v2(n),v3(n)

real*8::H0(n,n),H1(n,n),df(n,n)

real*8::m1(n,n),m2(n,n),m3(n,n)

call jac(df,x0)

call inv(df,H0,N)

write(11,101)

write(12,102)

do i=1,itmax

   call func(f0,x0)

   x1=x0-matmul(H0,f0)

   dx=x1-x0

   call func(f1,x1)

   y=f1-f0

   v1=matmul(H0,y)

   t1=vdot(y,v1,n)

   t2=vdot(dx,y,N)

   u=1d0+t1/t2

   m1=vvmat(dx,dx,n)*u

   m2=vvmat(dx,y,n)

   m2=matmul(m2,H0)

   v3=matmul(H0,y)

   m3=vvmat(v3,dx,n)

   t3=vdot(dx,y,n)

   H1=(m1-m2-m3)/t3

   H1=H0+H1

   write(12,103)i,H0

   x0x=1

   H0=H1

   write(11,104)i,x0

   dx2=dsqrt(dx(1)**2+dx(2)**2)

   if(dx2
end do

101  format(/,T5,'BFS方法計(jì)算序列',/)

102  format(/,T5,'BFS方法H矩陣序列為:',/)

103  format(T5,'iter=',I4,/,(F16.10/),/)

104  format(I8,3F16.10)

end subroutine solve

function vdot(a,b,N)

integer::i,N

real*8::a(n),b(n),vdot

vdot=0

do i=1,N

   vdot=vdot+a(i)*b(i)

end do

end function vdot

function vvmat(a,b,n)

integer::n,i,j

real*8::a(n),b(n),vvmat(n,n)

do i=1,n

   do j=1,n

     vvmat(i,j)=a(i)*b(j)

   end do

end do

end function  vvmat

subroutine func(f,x)

implicit real*8(a-z)

real*8::x(3),f(3),pi=3.14159263589793

f(1)=3*x(1)-dcos(x(2)*x(3))-1d0/2

f(2)=x(1)**2-81*(x(2)+0.1d0)**2+dsin(x(3))+1.06d0

f(3)=dexp(-x(1)*x(2))+20*x(3)+(10*pi-3d0)/3

end subroutine func

subroutine jac(df,x)

implicit real*8(a-z)

real*8::x(3),df(3,3)

df(1,1)=3d0

df(1,2)=x(3)*dsin(x(2)*x(3))

df(1,3)=x(2)*dsin(x(2)*x(3))

df(2,1)=2*x(1)

df(2,2)=-162*(x(1)+0.1)

df(2,3)=dcos(x(3))

df(3,1)=-x(2)*dexp(-x(1)*x(2))

df(3,2)=-x(1)*dexp(-x(1)*x(2))

df(3,3)=20d0

end subroutine jac

end module m_bfs

program main

use inv_mat

use m_bfs

implicit real*8(a-z)

integer::N=3

real*8::x0(3)

open(unit=11,file='result.txt')

open(unit=12,file='Hmatrix.txt')

x0=(/0.1d0,0.1d0,-0.1d0/)

call solve(x0,n,1d-8)

end program main

回復(fù)此樓

» 猜你喜歡

環(huán)境285分，過六級，求調(diào)劑已經(jīng)有4人回復(fù)
學(xué)碩化學(xué)工程與技術(shù)，一志愿中國海洋大學(xué)320+求調(diào)劑已經(jīng)有3人回復(fù)
能源動力調(diào)劑已經(jīng)有3人回復(fù)
348求調(diào)劑已經(jīng)有4人回復(fù)
材料化工340求調(diào)劑已經(jīng)有5人回復(fù)
08工科求調(diào)劑290分已經(jīng)有6人回復(fù)
材料調(diào)劑已經(jīng)有3人回復(fù)
372分材料與化工（085600）一志愿湖南大學(xué)求調(diào)劑已經(jīng)有4人回復(fù)
283分材料與化工求調(diào)劑已經(jīng)有4人回復(fù)
一志愿華東理工大學(xué)，080500學(xué)碩，317分，求調(diào)劑已經(jīng)有12人回復(fù)

» 本主題相關(guān)價值貼推薦，對您同樣有幫助:

請教一個應(yīng)用read時出現(xiàn)數(shù)組越界的問題，謝謝已經(jīng)有7人回復(fù)
有會看fortran程序的，能幫忙看看這個程序嗎？已經(jīng)有10人回復(fù)
怎么使用fortran程序創(chuàng)建一個立方晶格模型已經(jīng)有5人回復(fù)
如何改變fortran的浮點(diǎn)精度已經(jīng)有28人回復(fù)
求助高手幫忙編一個Fortran的小程序，重金懸賞...... 已經(jīng)有15人回復(fù)
求助計(jì)算機(jī)高人，編寫個Fortran程序已經(jīng)有13人回復(fù)
請教一個fortran小程序編譯出錯的問題，謝謝已經(jīng)有9人回復(fù)
寫了一個fortran90的小程序，編譯通不過，請大俠幫忙已經(jīng)有59人回復(fù)
【求助】如何寫FORTRAN程序?qū)崿F(xiàn)求平均最近鄰距離已經(jīng)有34人回復(fù)
【求助】求高手關(guān)于Fortran數(shù)據(jù)讀寫的問題�！疽淹杲Y(jié)】已經(jīng)有12人回復(fù)
【求助】請問fortran90與95區(qū)別大嗎已經(jīng)有4人回復(fù)
【求助】此FORTRAN90程序沒有錯誤，但是運(yùn)行不出來。已經(jīng)有4人回復(fù)
【求助】求助個Fortran計(jì)算，應(yīng)該不難，半天搞不定，請高手幫忙已經(jīng)有11人回復(fù)

好好學(xué)習(xí)，天天向上。

1樓 2011-11-11 23:00:16

已閱回復(fù)此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

snoopyzhao

至尊木蟲 (職業(yè)作家)

程序強(qiáng)帖: 16
應(yīng)助: 157 (高中生)
貴賓: 0.02
金幣: 18844.7
紅花: 29
帖子: 3803
在線: 1422.4小時
蟲號: 183750
注冊: 2006-02-13
專業(yè): 污染生態(tài)化學(xué)

【答案】應(yīng)助回帖

★
dubo(金幣+1): 多謝應(yīng)助 2011-11-12 12:26:34
zyj8119(金幣+10): 建議很好，會認(rèn)真考慮撒。。。 2011-11-12 14:04:34
ben_ladeng: 專家考核存檔 2011-11-12 23:23:16

引用回帖:

3樓: Originally posted by zyj8119 at 2011-11-11 23:29:18:
謝謝提醒，修改過來了，編譯通過。。

從這個錯誤來看，一定要用 implicit none……

另外，盡可能不要用 real*4、real*8 這些編譯器擴(kuò)展的用法

贊一下(2人)

回復(fù)此樓

4樓2011-11-12 12:13:01

已閱回復(fù)此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

查看全部 6 個回答

maomao1210

金蟲 (正式寫手)

程序強(qiáng)帖: 5
應(yīng)助: 2 (幼兒園)
金幣: 1432.8
散金: 242
紅花: 16
沙發(fā): 1
帖子: 991
在線: 442.1小時
蟲號: 253215
注冊: 2006-05-20
性別: MM
專業(yè): 考古理論

★
jjdg(金幣+1): 感謝參與 2011-11-12 00:40:40
xzhdty: 2011-11-12 22:51:02
ben_ladeng: 專家考核存檔 2011-11-12 23:23:07

引用回帖:

1樓: Originally posted by zyj8119 at 2011-11-11 23:00:16:
[code]module inv_mat
contains
subroutine inv(A,invA,N)
implicit real*8(a-z)
integer::n
integer::i
real*8::A(n,n),invA(n,n),E(n,n)
E=0
do i=1,n
E(i,i)=1
end do
call mateq(A,B,X,N,N)
e ...

大哥；
子程序 inv, X是數(shù)組，你忘記定義了。X（n,n）

贊一下(3人)

回復(fù)此樓

2樓2011-11-11 23:15:23

已閱回復(fù)此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

zyj8119

木蟲 (著名寫手)

應(yīng)助: 65 (初中生)
貴賓: 0.003
金幣: 915.1
散金: 1440
紅花: 35
帖子: 2936
在線: 1329.4小時
蟲號: 664177
注冊: 2008-11-29
性別: GG
專業(yè): 理論和計(jì)算化學(xué)

引用回帖:

2樓: Originally posted by maomao1210 at 2011-11-11 23:15:23:
大哥；
子程序 inv, X是數(shù)組，你忘記定義了。X（n,n）

謝謝提醒，修改過來了，編譯通過。。

贊一下

回復(fù)此樓

好好學(xué)習(xí)，天天向上。

3樓2011-11-11 23:29:18

已閱回復(fù)此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

exabyss916

新蟲 (小有名氣)

應(yīng)助: 1 (幼兒園)
金幣: 177
散金: 65
帖子: 78
在線: 57小時
蟲號: 507882
注冊: 2008-02-20
專業(yè): 理論和計(jì)算化學(xué)

引用回帖:

4樓: Originally posted by snoopyzhao at 2011-11-12 12:13:01:
從這個錯誤來看，一定要用 implicit none……

另外，盡可能不要用 real*4、real*8 這些編譯器擴(kuò)展的用法

能不能簡單說一下為什么盡可能不要用 real*4、real*8 這些編譯器擴(kuò)展的用法？

贊一下

回復(fù)此樓

5樓2011-11-19 10:45:59

已閱回復(fù)此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

最具人氣熱帖推薦 [查看全部]	作者	回/看	最后發(fā)表

[考研] 一志愿北京科技大學(xué)085601材料工程英一數(shù)二初試總分335求調(diào)劑 +9	雙馬尾痞老板2 2026-04-01	9/450	2026-04-02 12:14 by oooqiao
[考研] 805600專碩材料與化工348分求調(diào)劑 +6	上學(xué)啦！ 2026-04-01	6/300	2026-04-02 07:49 by 2026材料調(diào)劑
[考研] 0856，269分求調(diào)劑 +8	有學(xué)上就行求求?/a> 2026-03-30	11/550	2026-04-01 22:33 by 2026材料調(diào)劑
[考研] 332求調(diào)劑 +8	Lyy930824@ 2026-03-29	8/400	2026-04-01 18:40 by 千鈞澄玉宇啊
[考研] 求調(diào)劑 +4	圖鑒212 2026-03-30	5/250	2026-04-01 15:32 by 圖鑒212
[論文投稿] chinese chemical letters英文版投稿求助 120+4	Yishengeryi 2026-03-30	5/250	2026-04-01 14:11 by 陸小果畫大餅
[考研] 070300化學(xué)專業(yè)279調(diào)劑 +10	哈哈哈^_^ 2026-03-31	10/500	2026-03-31 23:13 by liu823948201
[考研] 086000調(diào)劑 +5	7901117076 2026-03-26	5/250	2026-03-31 17:45 by 544594351
[考研] 一志愿南昌大學(xué)324求調(diào)劑 +6	hanamiko 2026-03-29	6/300	2026-03-31 16:35 by hypershenger
[考研] 263求調(diào)劑 +3	DDDDuu 2026-03-27	3/150	2026-03-31 16:21 by 土木碩士招生
[考研] 289求調(diào)劑 +3	Acesczlo 2026-03-29	4/200	2026-03-31 14:48 by 熱情沙漠
[考研] 英一數(shù)一總分334求調(diào)劑 +4	陳陽坤 2026-03-31	4/200	2026-03-31 14:22 by 記事本2026
[考研] 求調(diào)劑 +8	11ggg 2026-03-30	8/400	2026-03-31 13:56 by nanaliuyun
[考研] 0703化學(xué) +20	妮妮ninicgb 2026-03-27	20/1000	2026-03-31 13:33 by 無際的草原
[考研] 276求調(diào)劑 +3	趙久華 2026-03-29	3/150	2026-03-31 10:06 by cal0306
[考研] 抱歉 +3	田洪有 2026-03-30	3/150	2026-03-30 19:11 by 迷糊CCPs
[考研] 材料專碩 085600求調(diào)劑 +7	BBQ233 2026-03-30	7/350	2026-03-30 17:44 by oooqiao
[考研] 085600，專業(yè)課化工原理，321分求調(diào)劑 +5	大饞小子 2026-03-28	5/250	2026-03-29 08:56 by qingfeng258
[考研] 265求調(diào)劑 +8	小木蟲085600 2026-03-27	8/400	2026-03-27 22:16 by 無際的草原
[考研] 266求調(diào)劑 +11	陽陽哇塞 2026-03-27	12/600	2026-03-27 17:56 by yu221