Fortran 板


LINE

我是用彭國倫FORTRAN95書裡面的"inverse.f90"作修該 module LinearAlgebra implicit none contains ! 求反矩陣 subroutine inverse(A,IA) implicit none real :: A(:,:), IA(:,:) real, allocatable :: B(:,:) integer :: i,j,N N = size(A,1) allocate(B(N,N)) ! 先把IA設定成單位矩陣 forall(i=1:N,j=1:N,i==j) IA(i,j)=1.0 forall(i=1:N,j=1:N,i/=j) IA(i,j)=0.0 ! 保存原先的矩陣A, 使用B來計算 B=A ! 把B化成對角線矩陣(除了對角線外,都為0) call Upper(B,IA,N) ! 先把B化成上三角矩陣 call Lower(B,IA,N) ! 再把B化成下三角矩陣 ! 求解 forall(i=1:N) IA(i,:)=IA(i,:)/B(i,i) return end subroutine ! 輸出矩陣的副程式 subroutine output(matrix) implicit none real :: matrix(:,:) integer :: m,n,i character(len=20) :: for='(??(1x,f6.3))' m = size(matrix,1) n = size(matrix,2) ! 用字串來設定輸出格式 write( FOR(2:3), '(I2)' ) N do i=1,N write( *, FMT=FOR ) matrix(i,:) end do return end subroutine output ! 求上三角矩陣的副程式 subroutine Upper(M,S,N) implicit none integer :: N real :: M(N,N) real :: S(N,N) integer :: I,J real :: E do I=1,N-1 do J=I+1,N E=M(J,I)/M(I,I) M(J,I:N)=M(J,I:N)-M(I,I:N)*E S(J,:)=S(J,:)-S(I,:)*E end do end do return end subroutine Upper ! 求下三角矩陣的副程式 subroutine Lower(M,S,N) implicit none integer :: N real :: M(N,N) real :: S(N,N) integer :: I,J real :: E do I=N,2,-1 do J=I-1,1,-1 E=M(J,I)/M(I,I) M(J,1:N)=M(J,1:N)-M(I,1:N)*E S(J,:)=S(J,:)-S(I,:)*E end do end do return end subroutine Lower end module ! 求解聯立式 program main use LinearAlgebra implicit none integer, parameter :: N=3 ! Size of Matrix real :: A(N,N) = (/1,2,3,4,5,6,7,8,8 /) real :: IA(N,N) integer :: i write(*,*) "原矩陣" call output(A) call inverse(A,IA) write(*,*) "反矩陣" call output(IA) stop end program 我要得到n維反矩陣 小弟程式跑出來的結果反矩陣一直都是零 不知道哪裡出了問題 有大大可以幫忙看一下嗎謝謝 以下程式暫時用3x3作測試 而g.dat 使用以下數值 1 2 3 4 5 6 7 8 8 算出結果應該如下 ans = -2.6667 2.6667 -1.0000 3.3333 -4.3333 2.0000 -1.0000 2.0000 -1.0000 修改後程式碼 program inv implicit none integer, parameter :: N=3 ! Size of Matrix real :: A(N,N) real :: IA(N,N) integer :: i,yy,zz open(unit=101,file='g.dat',status='old') !write(101,*) "Matrix:" DO yy = 1, 3 read(101,*) (A(yy,zz), zz = 1, 3) END DO open(30, file="result.dat",status="unknown") write(30,*) "原矩陣" DO yy = 1, 36 do zz= 1, 36 write(30,*) yy,zz,A(yy,zz) END DO END DO call output(A) call output(IA) call inverse(A,IA) write(30,*) "反矩陣" DO yy = 1, 36 do zz= 1, 36 write(30,*) yy,zz,IA(yy,zz) END DO END DO stop end program ! 輸出矩陣的副程式 subroutine output(matrix) real :: matrix(:,:) integer :: m,n,i character(len=20) :: for='(??(1x,f6.3))' m = size(matrix,1) n = size(matrix,2) ! 用字串來設定輸出格式 write( FOR(2:3), '(I2)' ) N do i=1,N write( *, FMT=FOR ) matrix(i,:) end do return end subroutine output ! 求反矩陣 subroutine inverse(A,IA) real :: A(:,:), IA(:,:) real, allocatable :: B(:,:) integer :: i,j,N N = size(A,1) allocate(B(N,N)) ! 先把IA設定成單位矩陣 forall(i=1:N,j=1:N,i==j) IA(i,j)=1.0 forall(i=1:N,j=1:N,i/=j) IA(i,j)=0.0 ! 保存原先的矩陣A, 使用B來計算 B=A ! 把B化成對角線矩陣(除了對角線外,都為0) call Upper(B,IA,N) ! 先把B化成上三角矩陣 call Lower(B,IA,N) ! 再把B化成下三角矩陣 ! 求解 forall(i=1:N) IA(i,:)=IA(i,:)/B(i,i) return end subroutine ! 求上三角矩陣的副程式 subroutine Upper(M,S,N) integer :: N real :: M(N,N) real :: S(N,N) integer :: I,J real :: E do I=1,N-1 do J=I+1,N E=M(J,I)/M(I,I) M(J,I:N)=M(J,I:N)-M(I,I:N)*E S(J,:)=S(J,:)-S(I,:)*E end do end do return end subroutine Upper ! 求下三角矩陣的副程式 subroutine Lower(M,S,N) integer :: N real :: M(N,N) real :: S(N,N) integer :: I,J real :: E do I=N,2,-1 do J=I-1,1,-1 E=M(J,I)/M(I,I) M(J,1:N)=M(J,1:N)-M(I,1:N)*E S(J,:)=S(J,:)-S(I,:)*E end do end do return end subroutine Lower --



※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 140.115.66.121 ※ 編輯: shockbon 來自: 140.115.66.121 (05/13 22:27)
1F:推 GP03:直接用IMSL的函式試試看? 05/13 22:31







like.gif 您可能會有興趣的文章
icon.png[問題/行為] 貓晚上進房間會不會有憋尿問題
icon.pngRe: [閒聊] 選了錯誤的女孩成為魔法少女 XDDDDDDDDDD
icon.png[正妹] 瑞典 一張
icon.png[心得] EMS高領長版毛衣.墨小樓MC1002
icon.png[分享] 丹龍隔熱紙GE55+33+22
icon.png[問題] 清洗洗衣機
icon.png[尋物] 窗台下的空間
icon.png[閒聊] 双極の女神1 木魔爵
icon.png[售車] 新竹 1997 march 1297cc 白色 四門
icon.png[討論] 能從照片感受到攝影者心情嗎
icon.png[狂賀] 賀賀賀賀 賀!島村卯月!總選舉NO.1
icon.png[難過] 羨慕白皮膚的女生
icon.png閱讀文章
icon.png[黑特]
icon.png[問題] SBK S1安裝於安全帽位置
icon.png[分享] 舊woo100絕版開箱!!
icon.pngRe: [無言] 關於小包衛生紙
icon.png[開箱] E5-2683V3 RX480Strix 快睿C1 簡單測試
icon.png[心得] 蒼の海賊龍 地獄 執行者16PT
icon.png[售車] 1999年Virage iO 1.8EXi
icon.png[心得] 挑戰33 LV10 獅子座pt solo
icon.png[閒聊] 手把手教你不被桶之新手主購教學
icon.png[分享] Civic Type R 量產版官方照無預警流出
icon.png[售車] Golf 4 2.0 銀色 自排
icon.png[出售] Graco提籃汽座(有底座)2000元誠可議
icon.png[問題] 請問補牙材質掉了還能再補嗎?(台中半年內
icon.png[問題] 44th 單曲 生寫竟然都給重複的啊啊!
icon.png[心得] 華南紅卡/icash 核卡
icon.png[問題] 拔牙矯正這樣正常嗎
icon.png[贈送] 老莫高業 初業 102年版
icon.png[情報] 三大行動支付 本季掀戰火
icon.png[寶寶] 博客來Amos水蠟筆5/1特價五折
icon.pngRe: [心得] 新鮮人一些面試分享
icon.png[心得] 蒼の海賊龍 地獄 麒麟25PT
icon.pngRe: [閒聊] (君の名は。雷慎入) 君名二創漫畫翻譯
icon.pngRe: [閒聊] OGN中場影片:失蹤人口局 (英文字幕)
icon.png[問題] 台灣大哥大4G訊號差
icon.png[出售] [全國]全新千尋侘草LED燈, 水草

請輸入看板名稱,例如:Tech_Job站內搜尋

TOP