lapack.F

Go to the documentation of this file.

!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!
 
! **************************************************************************************************
!> \brief Interface to the LAPACK F77 library
!> \par History
!>      JGH (26-5-2001): New flag __SGL
!>                     : Added SVD routines
!>      JGH (30-5-2001): Added Cholesky factorisation and triangular inverse
!>      JGH (23-1-2009): Added linear system solution by SVD
!> \author APSI
! **************************************************************************************************
MODULE lapack
 
   IMPLICIT NONE
 
   PRIVATE
 
   ! API
   PUBLIC :: lapack_ssyev, lapack_chpev, &
             lapack_sgesvd, lapack_cgesvd, &
             lapack_sgesv, lapack_sgelss, &
             lapack_ssygv, lapack_sgbsv, &
             lapack_spotrf, lapack_strtri
 
   INTERFACE lapack_ssyev
! **************************************************************************************************
!> \brief ...
!> \param jobz ...
!> \param uplo ...
!> \param n ...
!> \param a ...
!> \param lda ...
!> \param w ...
!> \param work ...
!> \param lwork ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dsyev(jobz, uplo, n, a, lda, w, work, lwork, info)
         USE kinds, ONLY: dp
      CHARACTER                                          :: jobz, uplo
      INTEGER                                            :: N, LDA
      REAL(KIND=dp)                                      :: a(lda, *), w(*), work(*)
      INTEGER                                            :: LWORK, INFO
 
      END SUBROUTINE dsyev
   END INTERFACE
 
   INTERFACE lapack_ssygv
! **************************************************************************************************
!> \brief ...
!> \param itype ...
!> \param jobz ...
!> \param uplo ...
!> \param n ...
!> \param a ...
!> \param lda ...
!> \param b ...
!> \param ldb ...
!> \param w ...
!> \param work ...
!> \param lwork ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dsygv(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, info)
         USE kinds, ONLY: dp
      INTEGER                                            :: itype
      CHARACTER                                          :: jobz, uplo
      INTEGER                                            :: N, LDA
      REAL(KIND=dp)                                      :: a(lda, *)
      INTEGER                                            :: LDB
      REAL(KIND=dp)                                      :: b(ldb, *), w(*), work(*)
      INTEGER                                            :: LWORK, INFO
 
      END SUBROUTINE dsygv
   END INTERFACE
 
   INTERFACE lapack_chpev
! **************************************************************************************************
!> \brief ...
!> \param jobz ...
!> \param uplo ...
!> \param n ...
!> \param ap ...
!> \param w ...
!> \param z ...
!> \param ldz ...
!> \param work ...
!> \param rwork ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE zhpev(jobz, uplo, n, ap, w, z, ldz, work, rwork, info)
         USE kinds, ONLY: dp
      CHARACTER                                          :: jobz, uplo
      INTEGER                                            :: n
      COMPLEX(KIND=dp)                                   :: ap(*)
      REAL(KIND=dp)                                      :: w(*)
      INTEGER                                            :: ldz
      COMPLEX(KIND=dp)                                   :: z(ldz, *), work(*)
      REAL(KIND=dp)                                      :: rwork(*)
      INTEGER                                            :: info
 
      END SUBROUTINE zhpev
   END INTERFACE
 
   INTERFACE lapack_sspgv
! **************************************************************************************************
!> \brief ...
!> \param itype ...
!> \param jobz ...
!> \param uplo ...
!> \param n ...
!> \param ap ...
!> \param bp ...
!> \param w ...
!> \param z ...
!> \param ldz ...
!> \param work ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dspgv(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, &
                       info)
         USE kinds, ONLY: dp
      INTEGER                                            :: itype
      CHARACTER                                          :: jobz, uplo
      INTEGER                                            :: n
      REAL(KIND=dp)                                      :: ap(*), bp(*), w(*)
      INTEGER                                            :: ldz
      REAL(KIND=dp)                                      :: z(ldz, *), work(*)
      INTEGER                                            :: info
 
      END SUBROUTINE dspgv
   END INTERFACE
 
   INTERFACE lapack_chpgv
! **************************************************************************************************
!> \brief ...
!> \param itype ...
!> \param jobz ...
!> \param uplo ...
!> \param n ...
!> \param ap ...
!> \param bp ...
!> \param w ...
!> \param z ...
!> \param ldz ...
!> \param work ...
!> \param rwork ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE zhpgv(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, &
                       rwork, info)
         USE kinds, ONLY: dp
      INTEGER                                            :: itype
      CHARACTER                                          :: jobz, uplo
      INTEGER                                            :: n
      COMPLEX(KIND=dp)                                   :: ap(*), bp(*)
      REAL(KIND=dp)                                      :: w(*)
      INTEGER                                            :: ldz
      COMPLEX(KIND=dp)                                   :: z(ldz, *), work(*)
      REAL(KIND=dp)                                      :: rwork(*)
      INTEGER                                            :: info
 
      END SUBROUTINE zhpgv
   END INTERFACE
 
   INTERFACE lapack_sgesvd
! **************************************************************************************************
!> \brief ...
!> \param jobu ...
!> \param jobvt ...
!> \param m ...
!> \param n ...
!> \param a ...
!> \param lda ...
!> \param s ...
!> \param u ...
!> \param ldu ...
!> \param vt ...
!> \param ldvt ...
!> \param work ...
!> \param lwork ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, &
                        work, lwork, info)
         USE kinds, ONLY: dp
      CHARACTER                                          :: jobu, jobvt
      INTEGER                                            :: m, n, lda
      REAL(KIND=dp)                                      :: a(lda, *), s(*)
      INTEGER                                            :: ldu
      REAL(KIND=dp)                                      :: u(ldu, *)
      INTEGER                                            :: ldvt
      REAL(KIND=dp)                                      :: vt(ldvt, *), work(*)
      INTEGER                                            :: lwork, info
 
      END SUBROUTINE dgesvd
   END INTERFACE
 
   INTERFACE lapack_cgesvd
! **************************************************************************************************
!> \brief ...
!> \param jobu ...
!> \param jobvt ...
!> \param m ...
!> \param n ...
!> \param a ...
!> \param lda ...
!> \param s ...
!> \param u ...
!> \param ldu ...
!> \param vt ...
!> \param ldvt ...
!> \param work ...
!> \param lwork ...
!> \param rwork ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE zgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, &
                        work, lwork, rwork, info)
         USE kinds, ONLY: dp
      CHARACTER                                          :: jobu, jobvt
      INTEGER                                            :: m, n, lda
      COMPLEX(KIND=dp)                                   :: a(lda, *)
      REAL(KIND=dp)                                      :: s(*)
      INTEGER                                            :: ldu
      COMPLEX(KIND=dp)                                   :: u(ldu, *)
      INTEGER                                            :: ldvt
      COMPLEX(KIND=dp)                                   :: vt(ldvt, *), work(*)
      INTEGER                                            :: lwork
      REAL(KIND=dp)                                      :: rwork(*)
      INTEGER                                            :: info
 
      END SUBROUTINE zgesvd
   END INTERFACE
 
   INTERFACE lapack_spotrf
! **************************************************************************************************
!> \brief ...
!> \param uplo ...
!> \param n ...
!> \param a ...
!> \param lda ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dpotrf(uplo, n, a, lda, info)
         USE kinds, ONLY: dp
      CHARACTER                                          :: uplo
      INTEGER                                            :: n, lda
      REAL(KIND=dp)                                      :: a(lda, *)
      INTEGER                                            :: info
 
      END SUBROUTINE dpotrf
   END INTERFACE
 
   INTERFACE lapack_cpotrf
! **************************************************************************************************
!> \brief ...
!> \param uplo ...
!> \param n ...
!> \param a ...
!> \param lda ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE zpotrf(uplo, n, a, lda, info)
         USE kinds, ONLY: dp
      CHARACTER                                          :: uplo
      INTEGER                                            :: n, lda
      COMPLEX(KIND=dp)                                   :: a(lda, *)
      INTEGER                                            :: info
 
      END SUBROUTINE zpotrf
   END INTERFACE
 
   INTERFACE lapack_strtri
! **************************************************************************************************
!> \brief ...
!> \param uplo ...
!> \param diag ...
!> \param n ...
!> \param a ...
!> \param lda ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dtrtri(uplo, diag, n, a, lda, info)
         USE kinds, ONLY: dp
      CHARACTER                                          :: uplo, diag
      INTEGER                                            :: n, lda
      REAL(KIND=dp)                                      :: a(lda, *)
      INTEGER                                            :: info
 
      END SUBROUTINE dtrtri
   END INTERFACE
 
   INTERFACE lapack_ctrtri
! **************************************************************************************************
!> \brief ...
!> \param uplo ...
!> \param diag ...
!> \param n ...
!> \param a ...
!> \param lda ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE ztrtri(uplo, diag, n, a, lda, info)
         USE kinds, ONLY: dp
      CHARACTER                                          :: uplo, diag
      INTEGER                                            :: n, lda
      COMPLEX(KIND=dp)                                   :: a(lda, *)
      INTEGER                                            :: info
 
      END SUBROUTINE ztrtri
   END INTERFACE
 
   INTERFACE lapack_sgesv
! **************************************************************************************************
!> \brief ...
!> \param n ...
!> \param nrhs ...
!> \param a ...
!> \param lda ...
!> \param ipiv ...
!> \param b ...
!> \param ldb ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
         USE kinds, ONLY: dp
      INTEGER                                            :: N, NRHS, LDA
      REAL(KIND=dp)                                      :: a(lda, *)
      INTEGER                                            :: IPIV(*), LDB
      REAL(KIND=dp)                                      :: b(ldb, *)
      INTEGER                                            :: INFO
 
      END SUBROUTINE dgesv
   END INTERFACE
 
   INTERFACE lapack_sgbsv
! **************************************************************************************************
!> \brief ...
!> \param n ...
!> \param kl ...
!> \param ku ...
!> \param nrhs ...
!> \param ab ...
!> \param ldab ...
!> \param ipiv ...
!> \param b ...
!> \param ldb ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dgbsv(n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
         USE kinds, ONLY: dp
      INTEGER                                            :: N, KL, KU, NRHS, LDAB
      REAL(KIND=dp)                                      :: ab(ldab, *)
      INTEGER                                            :: IPIV(*), LDB
      REAL(KIND=dp)                                      :: b(ldb, *)
      INTEGER                                            :: INFO
 
      END SUBROUTINE dgbsv
   END INTERFACE
 
   INTERFACE lapack_sgelss
! **************************************************************************************************
!> \brief ...
!> \param m ...
!> \param n ...
!> \param nrhs ...
!> \param a ...
!> \param lda ...
!> \param b ...
!> \param ldb ...
!> \param s ...
!> \param rcond ...
!> \param rank ...
!> \param work ...
!> \param lwork ...
!> \param info ...
! **************************************************************************************************
      SUBROUTINE dgelss(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, info)
         USE kinds, ONLY: dp
      INTEGER                                            :: m, n, nrhs, lda
      REAL(KIND=dp)                                      :: a(lda, *)
      INTEGER                                            :: ldb
      REAL(KIND=dp)                                      :: b(ldb, *), s(*), rcond
      INTEGER                                            :: rank
      REAL(KIND=dp)                                      :: work(*)
      INTEGER                                            :: lwork, info
 
      END SUBROUTINE dgelss
   END INTERFACE
 
END MODULE lapack