lapack_wrapper.fpp Source File


Contents

Source Code


Source Code

!> A small module just designed to provide interfaces to commonly used
!> lapack routines so that we can forget about the precision of the
!> arguments at the calling site and the compiler has some information
!> about the lapack routine arguments.
!>
!> Requires the code to be linked against lapack so we currently have
!> to take care to guard against having `use lapack_wrapper` when we
!> don't have lapack available. We could further guard against this
!> by only allowing this module to be non-empty when LAPACK is defined.
module lapack_wrapper
  use iso_fortran_env, only: real32, real64

  implicit none

  private

  public :: getrf, getri, gemm, gemv

  ! Public interfaces hiding the details of the precision of the arugments.

  interface getrf
     procedure cgetrf
     procedure zgetrf
  end interface getrf

  interface getri
     procedure cgetri
     procedure zgetri
  end interface getri

  interface gemm
     procedure cgemm
     procedure zgemm
  end interface gemm

  interface gemv
     procedure cgemv
     procedure zgemv
  end interface gemv

  ! Private interfaces to the actual lapack routines to give the compiler
  ! some basic information.

  interface
     subroutine cgetrf( m, n, a, lda, ipiv, info)
       import real32
       integer :: m, n, lda, info
       integer, dimension(*) :: ipiv
       complex(kind=real32), dimension(lda, *) :: a
     end subroutine cgetrf

     subroutine zgetrf( m, n, a, lda, ipiv, info)
       import real64
       integer :: m, n, lda, info
       integer, dimension(*) :: ipiv
       complex(kind=real64), dimension(lda, *) :: a
     end subroutine zgetrf

     subroutine cgetri( n, a, lda, ipiv, work, lwork, info )
       import real32
       integer :: n, lda, lwork, info
       integer, dimension(*) :: ipiv
       complex(kind=real32), dimension(*) :: work
       complex(kind=real32), dimension(lda, *) :: a
     end subroutine cgetri

     subroutine zgetri( n, a, lda, ipiv, work, lwork, info )
       import real64
       integer :: n, lda, lwork, info
       integer, dimension(*) :: ipiv
       complex(kind=real64), dimension(*) :: work
       complex(kind=real64), dimension(lda, *) :: a
     end subroutine zgetri

     subroutine cgemm( transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
       import real32
       character :: transa, transb
       integer :: m, n, k, lda, ldb, ldc
       complex(kind=real32) :: alpha, beta
       complex(kind=real32), dimension(lda, *) :: a
       complex(kind=real32), dimension(ldb, *) :: b
       complex(kind=real32), dimension(ldc, *) :: c
     end subroutine cgemm

     subroutine zgemm( transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
       import real64
       character :: transa, transb
       integer :: m, n, k, lda, ldb, ldc
       complex(kind=real64) :: alpha, beta
       complex(kind=real64), dimension(lda, *) :: a
       complex(kind=real64), dimension(ldb, *) :: b
       complex(kind=real64), dimension(ldc, *) :: c
     end subroutine zgemm

     subroutine cgemv( trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
       import real32
       character :: trans
       integer :: m, n, lda, incx, incy
       complex(kind=real32) :: alpha, beta
       complex(kind=real32), dimension(lda, *) :: a
       complex(kind=real32), dimension(*) :: x, y
     end subroutine cgemv

     subroutine zgemv( trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
       import real64
       character :: trans
       integer :: m, n, lda, incx, incy
       complex(kind=real64) :: alpha, beta
       complex(kind=real64), dimension(lda, *) :: a
       complex(kind=real64), dimension(*) :: x, y
     end subroutine zgemv

  end interface
end module lapack_wrapper