矩阵求逆的结果错误

时间:2017-04-13 10:39:07

标签: fortran matrix-inverse

我想制作一个能使矩阵反转的函数。

我使用算法

Ax(j) = I(j)

其中xA的倒置,x(j)j - 第x列,I(j)j身份矩阵的第一列。然后我合并列向量并进行矩阵的反演。所以我实现了高斯消元法和矩阵求逆算法。

program inversion
    implicit none
    real(4), allocatable, dimension(:,:) :: A,B
    real(4), dimension(4,1) :: c

    A = reshape((/2,-1,0,0,-1,2,-1,0,0,-1,2,-1,0,0,-1,2/),(/4,4/))
    c = reshape((/1,2,3,4/),(/4,1/))

    write(*,*), inverse(A)

    contains
    function gauss_eli(A,b) result(z)
        implicit none
        integer :: n, i, j, k
        real(4) :: factor, s
        real(4), allocatable, dimension(:,:) :: A
        integer, dimension(2) :: m
        real(4), dimension(int(sum(shape(A))/2),1) :: b
        real(4), dimension(int(sum(shape(b)))) :: z
        m = shape(A)
        n = m(1)
        do k=1,n-1
            do i=k+1,n
                factor = A(i,k)/A(k,k)
                do j=k+1,n
                    A(i,j)=A(i,j)-factor*A(k,j)
                enddo
                b(i,1) = b(i,1)-factor*b(k,1)
            enddo
        enddo
        z(n) = b(n,1)/A(n,n)
        do i=n-1,1,-1
            s = b(i,1)
            do j=i+1,n
                s = s-A(i,j)*z(j)
            enddo
            z(i) = s/A(i,i)
        enddo
    end function

    function upper(A) result(x)
        implicit none
        integer :: i,k,n,j
        real(4) :: factor
        real(4), allocatable, dimension(:,:) :: A
        integer, dimension(2) :: m
        real(4), dimension(int(sum(shape(A))/2),int(sum(shape(A)))/2) :: x
        m = shape(A)
        n = m(1)
        x = A
        do k=1,n-1
            do i=k+1,n
                factor = x(i,k)/x(k,k)
                do j=k,n
                    x(i,j)=x(i,j)-factor*x(k,j)
                enddo
            enddo
        enddo
    end function

    function lower(A) result(y)
        implicit none
        integer :: i,j,k,n
        integer, dimension(2) :: m
        real(4) :: c
        real(4), allocatable, dimension(:,:) :: A, B
        real(4), dimension(int(sum(shape(A))/2),int(sum(shape(A)))/2) :: y
        B = upper(A)
        m = shape(A)
        n = m(1)
        !L(i,j) = 1/U(i,j)*(A(i,j)-sig(1 to j-1){L(i,k)U(k,j)})        
        do j=1,n
            do i=j,n
                if (j==1) then
                    y(i,j) = A(i,j)/B(j,j)
                else
                    c = 0
                    do k=1,j-1
                        c = c + y(i,k)*B(k,j)
                    enddo
                    y(i,j) = (A(i,j)-c)/B(j,j)
                endif
            enddo
        enddo

        do i=1,n
            do j=1,n
                if (i<j) then
                    y(i,j) = 0
                endif
            enddo
        enddo
    end function

    function iden(A) result(g)
        implicit none
        real(4), allocatable, dimension(:,:) :: A
        real(4), dimension(int(sum(shape(A))/2),int(sum(shape(A)))/2) :: g
        integer :: i,j,n
        integer, allocatable, dimension(:) :: m
        m = shape(A)
        n = m(1)
        do i=1,n
            do j=1,n
                if (i==j) then
                    g(i,j) = 1.0
                else
                    g(i,j) = 0.0
                endif
            enddo
        enddo
    end function

    function inverse(A) result(z)
        implicit none
        integer :: c,n,i
        real(4), allocatable, dimension(:,:) :: A
        real(4), dimension(int(sum(shape(A))/2),int(sum(shape(A))/2)) :: h,z,d
        integer, dimension(2) :: m
        real(4), allocatable, dimension(:) :: B
        m = shape(A)
        n = m(1)
        d = iden(A)
        do c=1,n
            B = gauss_eli(A,d(:,c))
            do i=1,n
                z(i,c) = B(i)
            enddo
        enddo

        !write(*,*), u
    end function


end program

但我无法正确反转A:the result

代码错了吗?

0 个答案:

没有答案