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

zyj8119

木蟲 (著名寫手)

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

[求助] 一個(gè)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分，過六級(jí)，求調(diào)劑已經(jīng)有4人回復(fù)
學(xué)碩化學(xué)工程與技術(shù)，一志愿中國海洋大學(xué)320+求調(diào)劑已經(jīng)有3人回復(fù)
能源動(dòng)力調(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)價(jià)值貼推薦，對(duì)您同樣有幫助:

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

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

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

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

exabyss916

新蟲 (小有名氣)

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

引用回帖:

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

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

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

贊一下

回復(fù)此樓

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

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

查看全部 6 個(gè)回答

maomao1210

金蟲 (正式寫手)

程序強(qiáng)帖: 5
應(yīng)助: 2 (幼兒園)
金幣: 1432.8
散金: 242
紅花: 16
沙發(fā): 1
帖子: 991
在線: 442.1小時(shí)
蟲號(hào): 253215
注冊(cè): 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小時(shí)
蟲號(hào): 664177
注冊(cè): 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的回帖

snoopyzhao

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

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

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

★
dubo(金幣+1): 多謝應(yīng)助 2011-11-12 12:26:34
zyj8119(金幣+10): 建議很好，會(huì)認(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:
謝謝提醒，修改過來了，編譯通過。。

從這個(gè)錯(cuò)誤來看，一定要用 implicit none……

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

贊一下(2人)

回復(fù)此樓

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

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

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

[考研] 一志愿華東理工大學(xué)，080500學(xué)碩，317分，求調(diào)劑 +12	s1145 2026-03-31	12/600	2026-04-02 12:38 by smileboy2006
[考研] 化工調(diào)劑303分，過四級(jí) +5	棲梧待風(fēng) 2026-04-02	5/250	2026-04-02 11:49 by ms629
[考研] 311求調(diào)劑 +9	勇敢的小吳 2026-04-02	9/450	2026-04-02 11:37 by Sammy2
[考研] 348求調(diào)劑 +6	小懶蟲不懶了 2026-03-27	7/350	2026-04-02 11:18 by sanrepian
[考研] 0710生物學(xué)336分求調(diào)劑 +3	kiyy 2026-04-01	3/150	2026-04-02 10:54 by w蟲蟲123
[考研] 377求調(diào)劑 +3	RASKIN 2026-04-02	3/150	2026-04-02 09:45 by zzchen2000
[考研] 江蘇科技大學(xué)招材料研究生 +4	Su032713. 2026-04-01	5/250	2026-04-01 22:03 by cccchenso
[考研] 070300化學(xué)279求調(diào)劑 +15	哈哈哈^_^ 2026-03-31	17/850	2026-04-01 21:37 by 給你你注意休息
[考研] 生物與醫(yī)藥考研調(diào)劑 +5	鐵憨憨123425 2026-03-31	5/250	2026-04-01 18:01 by syh9288
[考研] 26考研調(diào)劑 +3	Wnz.20030617 2026-04-01	3/150	2026-04-01 17:22 by salamander`
[碩博家園] 博一被送出聯(lián)培感覺不適應(yīng)怎么辦 +3	全村的狗 2026-03-31	3/150	2026-04-01 10:44 by 328838485
[考研] 333求調(diào)劑 +4	阿科逸 2026-03-31	4/200	2026-04-01 09:11 by jp9609
[考研] 289求調(diào)劑 +7	BrightLL 2026-03-29	7/350	2026-03-31 22:05 by 544594351
[考研] 物理學(xué)調(diào)劑 +4	小羊36 2026-03-30	4/200	2026-03-31 16:16 by lishahe
[考研] 081200-11408-276學(xué)碩求調(diào)劑 +4	崔wj 2026-03-31	4/200	2026-03-31 11:56 by jp9609
[考研] 食品工程專碩一志愿中海洋309求調(diào)劑 +5	小張zxy張 2026-03-26	10/500	2026-03-31 00:29 by jp9609
[考研] 085602化工求調(diào)劑（331分） +8	111@127 2026-03-30	8/400	2026-03-30 21:23 by 研究僧導(dǎo)導(dǎo)
[考研] 085701環(huán)境工程求調(diào)劑 +11	多久上課 2026-03-27	12/600	2026-03-30 21:21 by 研究僧導(dǎo)導(dǎo)
[考研] 085600，專業(yè)課化工原理，321分求調(diào)劑 +5	大饞小子 2026-03-28	5/250	2026-03-29 08:56 by qingfeng258
[考研] 復(fù)試調(diào)劑，一志愿南農(nóng)083200食品科學(xué)與工程 +5	XQTJZ 2026-03-26	5/250	2026-03-27 14:49 by 狂炫麥當(dāng)當(dāng)