zyj8119

木蟲 (著名寫手)

應(yīng)助: 65 (初中生)
貴賓: 0.003
金幣: 915.1
散金: 1440
紅花: 35
帖子: 2936
在線: 1329.4小時(shí)
蟲號(hào): 664177
注冊: 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的回帖

maomao1210

金蟲 (正式寫手)

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

snoopyzhao

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

程序強(qiáng)帖: 16
應(yīng)助: 157 (高中生)
貴賓: 0.02
金幣: 18844.7
紅花: 29
帖子: 3803
在線: 1422.4小時(shí)
蟲號(hào): 183750
注冊: 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的回帖

exabyss916

新蟲 (小有名氣)

應(yīng)助: 1 (幼兒園)
金幣: 177
散金: 65
帖子: 78
在線: 57小時(shí)
蟲號(hào): 507882
注冊: 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ò)展的用法

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

贊一下

回復(fù)此樓

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

已閱回復(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
注冊: 2006-02-13
專業(yè): 污染生態(tài)化學(xué)

★
余澤成(金幣+1): 謝謝參與應(yīng)助！ 2011-11-19 14:31:13

引用回帖:

5樓: Originally posted by exabyss916 at 2011-11-19 10:45:59:
能不能簡單說一下為什么盡可能不要用 real*4、real*8 這些編譯器擴(kuò)展的用法？

因?yàn)椴皇菢?biāo)準(zhǔn)，所以盡可能不要用……

有興趣的話，可以搜一下 comp.lang.fortan 上的 is real*8 a standard declaration style?

大概有 80 多條回復(fù)，基本上都是 Fortran 界的 old-timer...

贊一下(1人)

回復(fù)此樓

6樓2011-11-19 10:55:33

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

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

[考研] 材料求調(diào)劑一志愿哈工大總分298分，前三科223分 +12	dongfang59 2026-03-27	12/600	2026-04-02 12:26 by ms629
[考研] 272求調(diào)劑，接受跨專業(yè)調(diào)劑！ +4	閑魚盧 2026-03-31	4/200	2026-04-02 11:18 by guyan1000
[考研] 材料專碩322分 +4	哈哈哈吼吼吼哈 2026-04-02	4/200	2026-04-02 10:26 by Wang200018
[考研] 292求調(diào)劑 +14	是妍子也是研子 2026-03-30	14/700	2026-04-02 10:17 by sanrepian
[考研] 322求調(diào)劑 +5	熹僖XX 2026-03-31	6/300	2026-04-02 10:08 by 求調(diào)劑zz
[考研] 296求調(diào)劑 +4	汪！？！ 2026-03-31	7/350	2026-04-01 22:04 by 客爾美德
[考研] 294分080500材料科學(xué)與工程求調(diào)劑 +15	柳溪邊 2026-03-26	16/800	2026-04-01 17:07 by 七度不信任
[考研] 285求調(diào)劑 +7	AZMK 2026-03-30	13/650	2026-04-01 17:00 by 七度不信任
[考研] 0856，材料與化工321分求調(diào)劑 +13	大饞小子 2026-03-27	14/700	2026-04-01 15:58 by yanflower7133
[考研] 086000生物與醫(yī)藥298調(diào)劑求助 +4	元元青青 2026-03-31	6/300	2026-04-01 11:13 by syh9288
[考研] 考研生物與醫(yī)藥調(diào)劑 +7	鐵憨憨123425 2026-03-31	7/350	2026-04-01 08:45 by JourneyLucky
[考研] 一志愿華東師范大學(xué)有機(jī)化學(xué)專業(yè)，初試351分，復(fù)試被刷求調(diào)劑! +9	真名有冰 2026-03-29	10/500	2026-03-31 18:01 by xhai2011
[考研] 340求調(diào)劑 +4	希望如此i 2026-03-31	4/200	2026-03-31 16:40 by 690616278
[考研] 22408 359分調(diào)劑 +4	Qshers 2026-03-27	8/400	2026-03-31 08:53 by Qshers
[考研] 332求調(diào)劑 +6	@MZB382400 2026-03-28	6/300	2026-03-30 16:57 by 無際的草原
[考研] 2026年華南師范大學(xué)歡迎化學(xué)，化工，生物，生醫(yī)工等專業(yè)優(yōu)秀學(xué)子加入！ +3	llss0711 2026-03-28	6/300	2026-03-29 10:26 by llss0711
[考研] 求調(diào)劑 +7	爭取九點(diǎn)睡 2026-03-28	8/400	2026-03-28 21:07 by 爭取九點(diǎn)睡
[考研] 304求調(diào)劑 +6	曼殊2266 2026-03-27	6/300	2026-03-28 14:10 by 唐沐兒
[考研] 352分化工與材料 +5	海納百川Ly 2026-03-27	5/250	2026-03-28 03:39 by fmesaito
[考研] 調(diào)劑求收留 +7	果然有我 2026-03-26	7/350	2026-03-27 00:26 by wxiongid