走进LAPACK（三）

五、BLAS和LAPACK的常用函数

  1、矩阵相乘（Matrix multiplication，A×B）

       BLAS函数（dgemm，zgemm）

函数原型：call dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc) （复数类型省略，下同）

输出：c Overwritten by the m-by-n matrix (alpha*op(A)*op(B) + beta*C).

program main

    implicit none
    real(8) :: aaa(2,2),bbb(2,1),ccc(2,1)
    aaa=reshape(  (/1,3,2,4/), (/2,2/)  )
    bbb=reshape(  (/3,5/),     (/2,1/)  )

    call dgemm( 'N', 'N', 2, 1, 2, 1.0d0, aaa, 2, bbb, 2, 0.0d0, ccc, 2 )
    print *,ccc

end program

输出结果

2、矩阵左除（Matrix left division，A\B）

      lapack函数（dgesv, zgesv (square matrices); dgelss, zgelss (non-square matrices)）

函数原型：call dgesv( n, nrhs, a, lda, ipiv, b, ldb, info )

输出：b Overwritten by the solution matrix X

函数原型：call dgelss(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, info)

输出：b Overwritten by the n-by-nrhs solution matrix X.

program main

    implicit none
    real(8) :: aaa(2,1),bbb(2,1),ccc(1,1)
    real(8) :: sss(1)
    integer :: rank,lwork,work(100),info
    lwork=100
    aaa=reshape(  (/1,2/),         (/2,1/)  )
    bbb=reshape(  (/1.1,2.1/),     (/2,1/)  )

    call dgelss( 2, 1, 1, aaa, 2, bbb, 2, sss, 0.0d0, rank, work, lwork ,info )
    ccc=bbb(1,1)
    print *,ccc

end program

输出结果

3、矩阵右除（Matrix right division，A/B）

    lapack函数（dgesv, zgesv (square matrices); dgelss, zgelss (non-square matrices)）

矩阵左除的变形

program main

    use lapack95
    implicit none
    real(8) :: aaa(1,2),bbb(1,2),ccc(1,1),aaa1(2,1),bbb1(2,1)
    real(8) :: sss(1)
    integer :: rank,lwork,work(100),info
    lwork=100
    aaa=reshape(  (/1.1,2.1/),         (/1,2/)  )
    bbb=reshape(  (/1,2/),     (/1,2/)  )

    aaa1=transpose(aaa)
    bbb1=transpose(bbb)

    call dgelss( 2, 1, 1, bbb1, 2, aaa1, 2, sss, 0.0d0, rank, work, lwork ,info )

    ccc=aaa1(1,1)

    print *,ccc

end program

输出结果

 

4、对角相似变换（diagonal similarity transform，）

    lapack函数（dgebal, zgebal）

函数原型：call dgebal(job, n, a, lda, ilo, ihi, scale, info)

输出：a  Overwritten by the balanced matrix

program main

    implicit none
    real(8) :: aaa(2,2),ttt(2,2),bbb(2,2)
    character(1) :: job
    integer :: n,lda,ilo,ihi,info,i
    real(8) :: scale(2)
    aaa=reshape(  (/1.d0,3d-6,2d6,4.d0/),         (/2,2/)  )
    job='B'
    n=2
    lda=2
    ttt=0.
    call dgebal( job, n, aaa, lda, ilo, ihi, scale, info )

    forall(i=1:2)
        ttt(i,i)=scale(i)
    end forall
    
    bbb=aaa
    
    print *,bbb
    print *,ttt

end program

输出结果

 

5、Cholesky分解（Cholesky decomposition，A = U^T*U，A = L*L^T）

    lapack函数（dpotrf, zpotrf）

函数原型：call dpotrf( uplo, n, a, lda, info )

输出：a   The upper or lower triangular part of a is overwritten by the Cholesky factor U or L, as specified by uplo.

program main

    implicit none
    real(8) :: aaa(2,2),uuu(2,2)
    character :: uplo
    integer :: n,lda,info,i,j

    aaa=reshape((/5,3,3,8/),(/2,2/))
    uplo='U'
    n=2
    lda=2
    uuu=0.

    call dpotrf( uplo, n, aaa, lda, info )

    forall(i=1:n,j=1:n,i<=j)
        uuu(i,j)=aaa(i,j)
    end forall

    print *,uuu

end program

输出结果

 

6、行列式（Determinant）

lapack函数（dgetrf, zgetrf）

函数原型：call dgetrf( m, n, a, lda, ipiv, info )

输出：a  Overwritten by L and U. The unit diagonal elements of L are not stored.

program main

    implicit none
    real(8) :: aaa(2,2),det
    integer :: m,n,info,i,ipiv,lda

    aaa=reshape((/1,3,2,4/),(/2,2/))
    m=2
    n=m
    lda=2
    det=1.0d0

    call dgetrf( m, n, aaa, lda, ipiv, info )

    do i=1,m
        det=det*aaa(i,i)
    enddo

    print *,det

end program

输出结果