Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/fortran/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Fortran 矩阵求逆的错误结果_Fortran_Matrix Inverse - Fatal编程技术网

Fortran 矩阵求逆的错误结果

Fortran 矩阵求逆的错误结果,fortran,matrix-inverse,Fortran,Matrix Inverse,我想做一个函数,它可以对矩阵求逆 我使用算法 Ax(j) = I(j) 其中,x是A的倒数,x(j)是j-x的第列,I(j)是身份矩阵的第列。然后合并列向量并对矩阵进行求逆。所以我提出并实现了高斯消去和矩阵求逆的算法 program inversion implicit none real(4), allocatable, dimension(:,:) :: A,B real(4), dimension(4,1) :: c A = reshape((/2,-1

我想做一个函数,它可以对矩阵求逆

我使用算法

Ax(j) = I(j)
其中,
x
A
的倒数,
x(j)
j
-x的第列,
I(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
程序反转
隐式无
实(4),可分配,维度(:,:)::A,B
实(4),维(4,1)::c
A=重塑((/2,-1,0,0,-1,2,-1,0,0,-1,2,-1,0,0,-1,2/),(/4,4/)
c=重塑((/1,2,3,4/),(/4,1/))
写(*,*),逆(A)
包含
函数gauss_eli(A,b)结果(z)
隐式无
整数::n,i,j,k
实数(4):系数,s
实(4),可分配,维度(:,:)::A
整数,维数(2)::m
实数(4),维数(int(sum(shape(A))/2),1)::b
实(4),维(int)(和(形(b))::z
m=形状(A)
n=m(1)
do k=1,n-1
i=k+1,n
系数=A(i,k)/A(k,k)
do j=k+1,n
A(i,j)=A(i,j)-因子*A(k,j)
结束循环
b(i,1)=b(i,1)-系数*b(k,1)
结束循环
结束循环
z(n)=b(n,1)/A(n,n)
i=n-1,1,-1吗
s=b(i,1)
do j=i+1,n
s=s-A(i,j)*z(j)
结束循环
z(i)=s/A(i,i)
结束循环
端函数
函数上限(A)结果(x)
隐式无
整数::i,k,n,j
真实(4):系数
实(4),可分配,维度(:,:)::A
整数,维数(2)::m
实(4),维(int(sum(shape(A))/2),int(sum(shape(A)))/2)::x
m=形状(A)
n=m(1)
x=A
do k=1,n-1
i=k+1,n
系数=x(i,k)/x(k,k)
do j=k,n
x(i,j)=x(i,j)-因子*x(k,j)
结束循环
结束循环
结束循环
端函数
功能降低(A)结果(y)
隐式无
整数::i,j,k,n
整数,维数(2)::m
雷亚尔(4)::c
实(4),可分配,维度(:,:)::A,B
实(4),维(int(sum(shape(A))/2),int(sum(shape(A)))/2)::y
B=上(A)
m=形状(A)
n=m(1)
!L(i,j)=1/U(i,j)*(A(i,j)-sig(1到j-1){L(i,k)U(k,j)})
do j=1,n
i=j,n吗
如果(j==1),则
y(i,j)=A(i,j)/B(j,j)
其他的
c=0
do k=1,j-1
c=c+y(i,k)*B(k,j)
结束循环
y(i,j)=(A(i,j)-c)/B(j,j)
恩迪夫
结束循环
结束循环
i=1,n吗
do j=1,n

如果(我)你使用了任何模块或接口块吗?请提供我们可以测试的完整代码。并描述你的代码发生了什么错误。有错误消息吗?它们看起来像什么?错误的结果?它们为什么是错误的?正确的结果应该是什么样的?我把矩阵a=重塑((/2,-1,0,0,-1,2,-1,0,0,-1,2,-1,0,0,-1,2/),(/4,4/)然后写(,)逆(A)结果是0.8,0.6,0.4,0.2,-0.5714283,-1142857,-2142857,-1714285,-0.9130432,-1.826086,-0.9130432,0.5217387楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠楠你反复地叫它,每次你都在反转一个不同的矩阵(为什么高斯消去法一次一列呢?)谢谢你,我试着编辑代码。非常非常感谢:)