Fortran 求矩阵的逆、行列式的值

 

 

#2019，10，8 更新：

    重写部分程序，增加部分注释

 

学Fortran的第一天，就写了这么点东西，分享一下。

内容包括：求矩阵的逆、行列式的值

其中：求逆的方法是先求伴随矩阵再除以行列式的值，

求行列式的值用的是求余子式的迭代法（从matlab里面的det函数获得的启发），

需要注意的是，Fortran中数组的存储是先列后行。

注释以后有空再加上吧。初学，程序有误或有待改进之处欢迎指正，有问题可以留言

感谢学习过程中帮助比较大的几个帖子及作者：

https://www.tutorialspoint.com/fortran/fortran_arrays.htm

https://blog.csdn.net/encaidx/article/details/7425707

http://bbs.fcode.cn/thread-1240-1-1.html

http://fcode.cn/guide-103-1.html

---

program main
    Implicit None
    integer::m=5,n=5
    integer::i
    real::A(5,5),B(5,5)
    !A=reshape((/1,8,3,4,5,6,7,8,9/),(/3,3/))
    A=reshape((/1, 2, 3, 4, 5 &
            ,12, 6, 7, 8, 9 &
            , 0, 3, 2, 8,12 &
            , 3, 4, 5, 6, 7 &
            , 1, 4, 2, 3, 5 &
            /),(/5,5/))
    write(*,*) "  A= "
    write(*,"(5f12.6)") (a(i,:),i=1,n)
    !write(*,"(3f12.6)") (a(i,:),i=1,n)
    write(*,"(/,A)") "inv A= "
    b=inv(a,n)
    write(*,"(5f12.6)") (b(i,:),i=1,n)
    !write(*,"(3f12.6)") (b(i,:),i=1,n)
    write(*,"(/,A)") "det A= "
    print *,det(A,m,n)
    read*
    
    contains

    !-----------递归求行列式的值--------------------
    recursive function det(A,col,row) result(D)
    Implicit None
    integer row,col
    real::A(col,row),B(row-1,col-1)
    real::D
    integer row_now,col_now,k,c,f
    row_now=row 
    col_now=col
    if (row_now>1) then
        D = 0.0;
        do k=1,row_now
            if(k==1)then
                B=A(2:col_now,2:row_now)
            elseif(k<row_now)then
                B(1:k-1,:)=A(1:k-1,2:row_now)
                B(k:col_now-1,:)=A(k+1:col_now,2:row_now)
            else
                B=A(1:col_now-1,2:row_now)
            endif
            c=col-1
            f=row-1
            D = D + (-1)**(1+k) * A(k,1) *&
                det(B,c,f)
        end do
    else
        D = A(1,1);
    end if
    end function det


    function delete_col_row(A,m,n,k,tar) result(b)
        !tar == 1，在 m*n 的矩阵中删去第 k 行
        !tar != 1，在 m*n 的矩阵中删去第 k 列,方便伴随矩阵的计算
        Implicit None
        integer::m,n,k,tar
        real::a(m,n)
        real,allocatable::B(:,:)
        if(tar==1)then
            allocate(B(m-1,n))
            if(k==1)then
                B=A(2:m,:)
            elseif(k<m)then
                B(1:k-1,:)=A(1:k-1,:)
                B(k:m-1,:)=A(k+1:m,:)
            else
                B=A(1:m-1,:)
            endif
        else
            allocate(B(m,n-1))
            if(k==1)then
                B=A(:,2:n)
            elseif(k<n)then
                B(:,1:k-1)=A(:,1:k-1)
                B(:,k:n-1)=A(:,k+1:n)
            else
                B=A(:,1:n-1)
            endif
        endif
    end function delete_col_row

! ------------用  A* / |A|  计算逆矩阵---------
    function inv(A,row) 
    Implicit None
    integer::row,i,j
    real::A(row,row)
    real::inv(row,row),b(row-1,row-1)
    do i=1,row
        do j=1,row
            b=delete_col_row(delete_col_row(A,row,row,i,1),row-1,row,j,2)
            inv(i,j)=(-1)**(i+j)*det(b,row-1,row-1)/det(A,row,row)
        end do
    end do
    inv=transpose(inv)
    end function inv
end program main

与matlab运行结果对比