cp_fm_dlaf_api.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                                                      !
!--------------------------------------------------------------------------------------------------!
 
MODULE cp_fm_dlaf_api
 
   USE iso_c_binding,                   ONLY: c_char,&
                                              c_double,&
                                              c_int,&
                                              c_loc,&
                                              c_ptr,&
                                              c_signed_char
   USE cp_fm_basic_linalg,              ONLY: cp_fm_upper_to_full
   USE cp_fm_types,                     ONLY: cp_fm_type
   USE kinds,                           ONLY: dp
#include "../base/base_uses.f90"
 
   IMPLICIT NONE
 
   PRIVATE
 
   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_fm_dlaf_api'
 
   PUBLIC :: cp_pdpotrf_dlaf, cp_pspotrf_dlaf
   PUBLIC :: cp_fm_diag_dlaf
 
CONTAINS
 
!***************************************************************************************************
!> \brief Cholesky factorization using DLA-Future
!> \param uplo ...
!> \param n Matrix size
!> \param a Local matrix
!> \param ia Row index of first row (has to be 1)
!> \param ja Col index of first column ()
!> \param desca ScaLAPACK matrix descriptor
!> \param info 0 if factorization completed normally
!> \author Rocco Meli
!> \author Mikael Simberg
!> \author Mathieu Taillefumier
! **************************************************************************************************
   SUBROUTINE cp_pdpotrf_dlaf(uplo, n, a, ia, ja, desca, info)
      CHARACTER, INTENT(IN)                              :: uplo
      INTEGER, INTENT(IN)                                :: n
      REAL(kind=dp), DIMENSION(:, :), TARGET             :: a
      INTEGER, INTENT(IN)                                :: ia, ja
      INTEGER, DIMENSION(9)                              :: desca
      INTEGER, TARGET                                    :: info
 
      CHARACTER(len=*), PARAMETER                        :: routinen = 'cp_pdpotrf_dlaf'
 
      INTEGER                                            :: handle
      INTERFACE
         SUBROUTINE pdpotrf_dlaf(uplo, n, a, ia, ja, desca, info) &
            bind(c, name='dlaf_pdpotrf')
            IMPORT :: c_ptr, c_int, c_double, c_signed_char
            INTEGER(KIND=C_SIGNED_CHAR), VALUE :: uplo
            INTEGER(KIND=C_INT), VALUE      ::        ia, ja, n
            TYPE(c_ptr), VALUE ::       info
            INTEGER(kind=C_INT), DIMENSION(*)         :: desca
            TYPE(c_ptr), VALUE ::              a
         END SUBROUTINE pdpotrf_dlaf
      END INTERFACE
 
      CALL timeset(routinen, handle)
 
#if defined(__DLAF)
      CALL pdpotrf_dlaf(iachar(uplo, c_signed_char), n, c_loc(a(1, 1)), ia, ja, desca, c_loc(info))
#else
      mark_used(uplo)
      mark_used(n)
      mark_used(a)
      mark_used(ia)
      mark_used(ja)
      mark_used(desca)
      mark_used(info)
      cpabort("CP2K compiled without the DLA-Future library.")
#endif
      CALL timestop(handle)
   END SUBROUTINE cp_pdpotrf_dlaf
 
!***************************************************************************************************
!> \brief Cholesky factorization using DLA-Future
!> \param uplo ...
!> \param n Matrix size
!> \param a Local matrix
!> \param ia Row index of first row (has to be 1)
!> \param ja Col index of first column ()
!> \param desca ScaLAPACK matrix descriptor
!> \param info 0 if factorization completed normally
!> \author Rocco Meli
!> \author Mikael Simberg
!> \author Mathieu Taillefumier
! **************************************************************************************************
   SUBROUTINE cp_pspotrf_dlaf(uplo, n, a, ia, ja, desca, info)
      CHARACTER, INTENT(IN)                              :: uplo
      INTEGER, INTENT(IN)                                :: n
      REAL, DIMENSION(:, :), TARGET                      :: a
      INTEGER, INTENT(IN)                                :: ia, ja
      INTEGER, DIMENSION(9)                              :: desca
      INTEGER, TARGET                                    :: info
 
      CHARACTER(len=*), PARAMETER                        :: routinen = 'cp_pspotrf_dlaf'
 
      INTEGER                                            :: handle
      INTERFACE
         SUBROUTINE pspotrf_dlaf(uplo, n, a, ia, ja, desca, info) &
            bind(c, name='dlaf_pspotrf')
            IMPORT :: c_ptr, c_int, c_double, c_signed_char
            INTEGER(KIND=C_SIGNED_CHAR), VALUE :: uplo
            INTEGER(KIND=C_INT), VALUE      ::        ia, ja, n
            TYPE(c_ptr), VALUE    ::       info
            INTEGER(kind=C_INT), DIMENSION(*)         :: desca
            TYPE(c_ptr), VALUE   ::              a
         END SUBROUTINE pspotrf_dlaf
      END INTERFACE
 
      CALL timeset(routinen, handle)
 
#if defined(__DLAF)
      CALL pspotrf_dlaf(iachar(uplo, c_signed_char), n, c_loc(a(1, 1)), ia, ja, desca, c_loc(info))
#else
      mark_used(uplo)
      mark_used(n)
      mark_used(a)
      mark_used(ia)
      mark_used(ja)
      mark_used(desca)
      mark_used(info)
      cpabort("CP2K compiled without the DLA-Future library.")
#endif
      CALL timestop(handle)
   END SUBROUTINE cp_pspotrf_dlaf
 
! **************************************************************************************************
!> \brief ...
!> \param matrix ...
!> \param eigenvectors ...
!> \param eigenvalues ...
! **************************************************************************************************
   SUBROUTINE cp_fm_diag_dlaf(matrix, eigenvectors, eigenvalues)
 
      TYPE(cp_fm_type), INTENT(IN)                       :: matrix, eigenvectors
      REAL(kind=dp), DIMENSION(:), INTENT(OUT)           :: eigenvalues
 
      CHARACTER(LEN=*), PARAMETER                        :: routinen = 'cp_fm_diag_dlaf'
 
      INTEGER                                            :: handle, n, nmo
      REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET   :: eig
 
      CALL timeset(routinen, handle)
 
      n = matrix%matrix_struct%nrow_global
      ALLOCATE (eig(n))
 
      CALL cp_fm_diag_dlaf_base(matrix, eigenvectors, eig)
 
      nmo = SIZE(eigenvalues, 1)
      IF (nmo > n) THEN
         eigenvalues(1:n) = eig(1:n)
      ELSE
         eigenvalues(1:nmo) = eig(1:nmo)
      END IF
 
      DEALLOCATE (eig)
 
      CALL timestop(handle)
 
   END SUBROUTINE cp_fm_diag_dlaf
 
!***************************************************************************************************
!> \brief DLA-Future eigensolver
!> \param matrix ...
!> \param eigenvectors ...
!> \param eigenvalues ...
!> \author Rocco Meli
! **************************************************************************************************
   SUBROUTINE cp_fm_diag_dlaf_base(matrix, eigenvectors, eigenvalues)
      TYPE(cp_fm_type), INTENT(IN)                       :: matrix, eigenvectors
      REAL(kind=dp), DIMENSION(:), INTENT(OUT), TARGET   :: eigenvalues
 
      CHARACTER(len=*), PARAMETER :: routinen = 'cp_fm_diag_dlaf_base'
      CHARACTER, PARAMETER                               :: uplo = 'L'
      CHARACTER(LEN=100)                                 :: message
      INTEGER                                            :: dlaf_handle, handle, n
      INTEGER, DIMENSION(9)                              :: desca, descz
      INTEGER, TARGET                                    :: info
      REAL(kind=dp), DIMENSION(:, :), POINTER            :: a, z
      INTERFACE
         SUBROUTINE pdsyevd_dlaf(uplo, n, a, ia, ja, desca, w, z, iz, jz, descz, info) &
            bind(c, name='dlaf_pdsyevd')
 
            IMPORT :: c_int, c_double, c_char, c_ptr, c_signed_char
 
            INTEGER(kind=C_SIGNED_CHAR), VALUE :: uplo
            INTEGER(kind=C_INT), VALUE :: n, ia, ja, iz, jz
            TYPE(c_ptr), VALUE :: a, w, z
            INTEGER(kind=C_INT), DIMENSION(9) :: desca, descz
            TYPE(c_ptr), VALUE :: info
         END SUBROUTINE pdsyevd_dlaf
      END INTERFACE
      CHARACTER(len=*), PARAMETER                        :: dlaf_name = 'pdsyevd_dlaf'
 
      CALL timeset(routinen, handle)
 
#if defined(__DLAF)
      ! DLAF needs the lower triangular part
      ! Use eigenvectors matrix as workspace
      CALL cp_fm_upper_to_full(matrix, eigenvectors)
 
      CALL timeset(dlaf_name, dlaf_handle)
 
      n = matrix%matrix_struct%nrow_global
 
      a => matrix%local_data
      z => eigenvectors%local_data
 
      desca(:) = matrix%matrix_struct%descriptor(:)
      descz(:) = eigenvectors%matrix_struct%descriptor(:)
 
      info = -1
 
      CALL pdsyevd_dlaf( &
         uplo=iachar(uplo, c_signed_char), &
         n=n, &
         a=c_loc(a(1, 1)), ia=1, ja=1, desca=desca, &
         w=c_loc(eigenvalues(1)), &
         z=c_loc(z(1, 1)), iz=1, jz=1, descz=descz, &
         info=c_loc(info) &
         )
 
      CALL timestop(dlaf_handle)
 
      IF (info /= 0) THEN
         WRITE (message, "(A,I0,A)") "ERROR in DLAF_PDSYEVD: Eigensolver failed (INFO = ", info, ")"
         cpabort(trim(message))
      END IF
#else
      mark_used(a)
      mark_used(z)
      mark_used(desca)
      mark_used(descz)
      mark_used(matrix)
      mark_used(eigenvectors)
      mark_used(eigenvalues)
      mark_used(uplo)
      mark_used(n)
      mark_used(info)
      mark_used(dlaf_handle)
      mark_used(dlaf_name)
      mark_used(message)
      cpabort("CP2K compiled without DLAF library.")
#endif
 
      CALL timestop(handle)
 
   END SUBROUTINE cp_fm_diag_dlaf_base
 
END MODULE cp_fm_dlaf_api