24小时热门版块排行榜    

北京石油化工学院2026年研究生招生接收调剂公告
查看: 2887  |  回复: 20
当前只显示满足指定条件的回帖,点击这里查看本话题的所有回帖

kimileegdut

捐助贵宾 (小有名气)

[求助] 逆矩阵运算 已有2人参与

求助各位大神,本人最近在编写一个程序,涉及到逆矩阵运算,而且矩阵维数很大(100*100),采用了西尔曼-莫里生公式求逆矩阵,但是后续计算结果有误,于是验算逆矩阵的正误,发现原来的矩阵和逆矩阵相乘不为单位阵,想请教一下各位前辈,这种情况求逆矩阵应该怎么处理?
回复此楼

» 猜你喜欢

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

pippi6

铁杆木虫 (著名写手)

工程和科学数值计算咨询

引用回帖:
10楼: Originally posted by kimileegdut at 2015-05-14 10:47:47
你好,我还有个问题想请教一下您,就是上面计算b=a*c的时候,为什么不直接用矩阵相乘语句b=matmul(a,c),而使用了循环?...

无所谓,应该也可以的
15楼2015-05-14 21:58:42
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 21 个回答

pippi6

铁杆木虫 (著名写手)

工程和科学数值计算咨询

【答案】应助回帖

★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★
感谢参与,应助指数 +1
kimileegdut: 金币+20, 有帮助 2015-05-11 11:49:44
试试这个 全面选主元的gauss消去。不行的话。把你的数据传上来


!flag
subroutine gaussr_inverse(a,n,np,b,m,mp)
  implicit none
  integer :: n,np,m,mp,i,j,k,irow,icol,l
  real*8 a(np,np),b(np,mp),pivinv,cc
  real*8, allocatable, dimension( :: dum
  real*8 big
  integer, allocatable, dimension( :: ipiv,indxr,indxc
  real*8, allocatable, dimension( :: c1

  allocate(ipiv(1:n),indxr(1:n),indxc(1:n),dum(1:max(n,m)),c1(1:n))
  ipiv=0

  !     row normalization (implicite pivoting)
  do i=1,n
     c1(i)=1/sqrt(sum(abs(a(i,1:n))**2))
     a(i,1:n)=a(i,1:n)*c1(i)
     b(i,1:m)=b(i,1:m)*c1(i)
  end do

  do i=1,n

     !     Full pivoting, however, not necessarily starting from 1st col
     big=0.d0
     do j=1,n
        if(ipiv(j)==1)cycle
        do k=1,n
           if (ipiv(k)==1) cycle
           if (abs(a(j,k)) <= big) cycle
           big=abs(a(j,k))
           irow=j
           icol=k
        end do
     end do

     !     ipiv(icol)=1 means the column icol has been selected once
     ipiv(icol)=ipiv(icol)+1
     if (irow.ne.icol) then

        !     exchange a(irow, with a(icol,
        !     so a(irow,irow) is the selected pivot
        dum(1:n)= a(irow,1:n)  
        a(irow,1:n)= a(icol,1:n)  
        a(icol,1:n)=dum(1:n)

        dum(1:m)= b(irow,1:m)  
        b(irow,1:m)= b(icol,1:m)  
        b(icol,1:m)=dum(1:m)
     endif

     !     bookkeeping row- and column-indices
     indxr(i)=irow
     indxc(i)=icol
     if (abs(a(icol,icol))==0.d0) pause 'singular matrix.'
     pivinv=1.d0/a(icol,icol)
     a(icol,icol)=1.d0
     a(icol,1:n)=a(icol,1:n)*pivinv
     b(icol,1:m)=b(icol,1:m)*pivinv

     do l=1,n
        if(l==icol)cycle  ! only for row l not equal to icol
        cc=a(l,icol)
        a(l,icol)=0.d0    ! clever design
        a(l,1:n)=a(l,1:n)-a(icol,1:n)*cc
        b(l,1:m)=b(l,1:m)-b(icol,1:m)*cc
     end do
  end do

  do l=1,n
     if(indxr(l) == indxc(l)) cycle
     dum(1:n)=a(1:n,indxr(l))
     a(1:n,indxr(l))=a(1:n,indxc(l))
     a(1:n,indxc(l))=dum(1:n)
  end do

  do i=1,n
     a(1:n,i)=a(1:n,i)*c1(i)
  end do

  deallocate(ipiv,indxr,indxc,dum,c1)
end subroutine gaussr_inverse
2楼2015-05-10 08:27:12
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

kimileegdut

捐助贵宾 (小有名气)

引用回帖:
2楼: Originally posted by pippi6 at 2015-05-10 08:27:12
试试这个 全面选主元的gauss消去。不行的话。把你的数据传上来


!flag
subroutine gaussr_inverse(a,n,np,b,m,mp)
  implicit none
  integer :: n,np,m,mp,i,j,k,irow,icol,l
  real*8 a(np,np),b(np,mp), ...

ok,我先试试,谢谢!
3楼2015-05-11 11:47:39
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

kimileegdut

捐助贵宾 (小有名气)

分享一个求逆矩阵的代码


SUBROUTINE INVERMAT(AA,N,AV)
!
!程序说明:利用西尔曼-莫里生(Sherman-Morrison)
!          公式求方阵[A]的逆矩阵,能够克服矩阵元素由于阶差较大引起的困难.
!          [A]存放在数组AA(N,N),逆矩阵存放在数组AV(N,N)中.
!
!
!定义数据类型:注意采用双精度浮点数
REAL(kind=8),DIMENSION(N,N)::AA,TA,AV
REAL(kind=8),DIMENSION(N)::VT,WK,DD
!
!
    DO i=1,N
      DO j=1,N
        TA(i,j)=AA(i,j)
      END DO
    END DO
!
!
    DO i=1,N
      DD(i)=1.D0
      IF(TA(i,i).NE.0.) DD(i)=SQRT(ABS(TA(i,i)))
      DO j=1,N
        TA(i,j)=TA(i,j)/DD(i)
        TA(j,i)=TA(j,i)/DD(i)
        AV(i,j)=0.D0
      END DO
      AV(i,i)=1.D0
      TA(i,i)=TA(i,i)-1.D0
      WK(i)=1.D0
    END DO
!
    LJK=0
30  ISW=0
    DO i=1,N
      IF(WK(i).LE.1.E-40) GOTO 40
      DO j=1,N
        VT(j)=0.D0
        DO k=1,N
          VT(j)=VT(j)+TA(i,k)*AV(k,j)
        END DO
      END DO
      VTA=1.D0+VT(i)
      IF(ABS(VTA).LE.1.E-40) GO TO 70
      WK(i)=0.
      DO j=1,N
        HH=AV(j,i)
        DO k=1,N
          AV(j,k)=AV(j,k)-HH*VT(k)/VTA
        END DO
      END DO
      GO TO 40
70    ISW=ISW+1
    END DO
40  CONTINUE
!
    IF(ISW.EQ.LJK) GO TO 80
    LJK=ISW
    GO TO 30
80  CONTINUE
    DO i=1,N
      DO j=1,N
        AV(i,j)=AV(i,j)/DD(i)/DD(j)
      END DO
    END DO
!
!
RETURN
END SUBROUTINE INVERMAT
4楼2015-05-11 18:03:28
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 0710生物学求调剂 +7 manman511 2026-04-01 7/350 2026-04-02 06:46 by ilovexiaobin
[考研] 材料考研调剂 +4 Gs大王 2026-04-02 4/200 2026-04-02 06:43 by wxiongid
[考研] 材料专硕322分 +10 哈哈哈吼吼吼哈 2026-04-01 10/500 2026-04-01 22:19 by Dyhoer
[考研] 286求调剂 +5 lim0922 2026-03-26 5/250 2026-04-01 19:08 by 客尔美德
[考研] 【求调剂】085601材料工程专硕 | 总分272 | +10 脚滑的守法公民 2026-03-27 10/500 2026-04-01 17:23 by pies112
[考研] 08工科275求调剂,可跨考。 +5 AaAa7420 2026-03-31 5/250 2026-04-01 15:21 by 159357hjz
[考研] 化学0703 调剂 306分 一志愿211 +12 26要上岸 2026-03-28 12/600 2026-04-01 11:10 by chemdavid
[考研] 学硕274求调剂 +17 Li李鱼 2026-03-26 17/850 2026-03-31 15:19 by 客尔美德
[考研] 277跪求调剂 +8 1915668 2026-03-27 13/650 2026-03-31 14:58 by 王亮_大连医科大
[考研] 一志愿哈尔滨工业大学材料与化工方向336分 +13 辰沐5211314 2026-03-26 13/650 2026-03-31 14:37 by 记事本2026
[考研] 334求调剂 +7 Trying] 2026-03-31 7/350 2026-03-31 12:33 by 无际的草原
[考研] 297 地理学070500 复试求调剂 +3 小圆圈圈ooo 2026-03-30 3/150 2026-03-30 21:05 by 余震yz
[考研] 285求调剂 +6 AZMK 2026-03-29 9/450 2026-03-30 21:02 by dophin1985
[考研] 327求调剂 +5 小卡不卡. 2026-03-29 5/250 2026-03-30 19:30 by Wang200018
[有机交流] 考研调剂 +8 watb 2026-03-26 8/400 2026-03-30 18:40 by 544594351
[考研] 332求92调剂 +8 蕉蕉123 2026-03-28 8/400 2026-03-29 10:46 by 周梓丹
[考研] 材料与化工(0856)304求B区调剂 +8 邱gl 2026-03-27 8/400 2026-03-28 12:42 by 唐沐儿
[考研] 330一志愿中国海洋大学 化学工程 085602 有读博意愿 求调剂 +3 wywy.. 2026-03-27 4/200 2026-03-28 03:32 by fmesaito
[考研] 341求调剂 +7 青柠檬1 2026-03-26 7/350 2026-03-27 00:19 by wxiongid
[考研] 321求调剂 +6 wasdssaa 2026-03-26 6/300 2026-03-26 20:57 by sanrepian
信息提示
请填处理意见