cp_fm_cusolver_api.F

Go to the documentation of this file.

!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!
 
! **************************************************************************************************
!> \brief Wrapper for cuSOLVERMp
!> \author Ole Schuett
! **************************************************************************************************
MODULE cp_fm_cusolver_api
   USE iso_c_binding,                   ONLY: c_double,&
                                              c_int
   USE cp_blacs_env,                    ONLY: cp_blacs_env_type
   USE cp_fm_types,                     ONLY: cp_fm_type
   USE kinds,                           ONLY: dp
#include "../base/base_uses.f90"
 
   IMPLICIT NONE
 
   PRIVATE
 
   PUBLIC :: cp_fm_diag_cusolver
   PUBLIC :: cp_fm_general_cusolver
 
CONTAINS
 
! **************************************************************************************************
!> \brief Driver routine to diagonalize a FM matrix with the cuSOLVERMp library.
!> \param matrix the matrix that is diagonalized
!> \param eigenvectors eigenvectors of the input matrix
!> \param eigenvalues eigenvalues of the input matrix
!> \author Ole Schuett
! **************************************************************************************************
   SUBROUTINE cp_fm_diag_cusolver(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_cusolver'
 
      INTEGER                                            :: handle, n, nmo
      REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: eigenvalues_buffer
      TYPE(cp_blacs_env_type), POINTER                   :: context
      INTERFACE
         SUBROUTINE cp_fm_diag_cusolver_c(fortran_comm, matrix_desc, &
                                          nprow, npcol, myprow, mypcol, &
                                          n, matrix, eigenvectors, eigenvalues) &
            BIND(C, name="cp_fm_diag_cusolver")
            IMPORT :: c_int, c_double
            INTEGER(kind=C_INT), VALUE                :: fortran_comm
            INTEGER(kind=C_INT), DIMENSION(*)         :: matrix_desc
            INTEGER(kind=C_INT), VALUE                :: nprow
            INTEGER(kind=C_INT), VALUE                :: npcol
            INTEGER(kind=C_INT), VALUE                :: myprow
            INTEGER(kind=C_INT), VALUE                :: mypcol
            INTEGER(kind=C_INT), VALUE                :: n
            REAL(kind=c_double), DIMENSION(*)         :: matrix
            REAL(kind=c_double), DIMENSION(*)         :: eigenvectors
            REAL(kind=c_double), DIMENSION(*)         :: eigenvalues
         END SUBROUTINE cp_fm_diag_cusolver_c
      END INTERFACE
 
      CALL timeset(routinen, handle)
 
#if defined(__CUSOLVERMP)
      n = matrix%matrix_struct%nrow_global
      context => matrix%matrix_struct%context
 
      ! The passed eigenvalues array might be smaller than n.
      ALLOCATE (eigenvalues_buffer(n))
 
      CALL cp_fm_diag_cusolver_c( &
         fortran_comm=matrix%matrix_struct%para_env%get_handle(), &
         matrix_desc=matrix%matrix_struct%descriptor, &
         nprow=context%num_pe(1), &
         npcol=context%num_pe(2), &
         myprow=context%mepos(1), &
         mypcol=context%mepos(2), &
         n=matrix%matrix_struct%nrow_global, &
         matrix=matrix%local_data, &
         eigenvectors=eigenvectors%local_data, &
         eigenvalues=eigenvalues_buffer)
 
      nmo = SIZE(eigenvalues)
      eigenvalues(1:nmo) = eigenvalues_buffer(1:nmo)
 
#else
      mark_used(matrix)
      mark_used(eigenvectors)
      eigenvalues = 0.0_dp
      mark_used(n)
      mark_used(nmo)
      mark_used(eigenvalues_buffer)
      mark_used(context)
      cpabort("CP2K compiled without the cuSOLVERMp library.")
#endif
 
      CALL timestop(handle)
   END SUBROUTINE cp_fm_diag_cusolver
 
! **************************************************************************************************
!> \brief Driver routine to solve generalized eigenvalue problem A*x = lambda*B*x with cuSOLVERMp.
!> \param aMatrix the first matrix for the generalized eigenvalue problem
!> \param bMatrix the second matrix for the generalized eigenvalue problem
!> \param eigenvectors eigenvectors of the input matrix
!> \param eigenvalues eigenvalues of the input matrix
! **************************************************************************************************
   SUBROUTINE cp_fm_general_cusolver(aMatrix, bMatrix, eigenvectors, eigenvalues)
      USE iso_c_binding, ONLY: c_int, c_double
      TYPE(cp_fm_type), INTENT(IN)                       :: amatrix, bmatrix, eigenvectors
      REAL(kind=dp), DIMENSION(:), INTENT(OUT)           :: eigenvalues
 
      CHARACTER(len=*), PARAMETER :: routinen = 'cp_fm_general_cusolver'
 
      INTEGER(kind=C_INT)                                :: handle, n, nmo
      REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: eigenvalues_buffer
      TYPE(cp_blacs_env_type), POINTER                   :: context
      INTERFACE
         SUBROUTINE cp_fm_general_cusolver_c(fortran_comm, a_matrix_desc, b_matrix_desc, &
                                             nprow, npcol, myprow, mypcol, &
                                             n, aMatrix, bMatrix, eigenvectors, eigenvalues) &
            BIND(C, name="cp_fm_diag_cusolver_sygvd")
            IMPORT :: c_int, c_double
            INTEGER(kind=C_INT), VALUE                :: fortran_comm
            INTEGER(kind=C_INT), DIMENSION(*)         :: a_matrix_desc, b_matrix_desc
            INTEGER(kind=C_INT), VALUE                :: nprow
            INTEGER(kind=C_INT), VALUE                :: npcol
            INTEGER(kind=C_INT), VALUE                :: myprow
            INTEGER(kind=C_INT), VALUE                :: mypcol
            INTEGER(kind=C_INT), VALUE                :: n
            REAL(kind=c_double), DIMENSION(*)         :: amatrix
            REAL(kind=c_double), DIMENSION(*)         :: bmatrix
            REAL(kind=c_double), DIMENSION(*)         :: eigenvectors
            REAL(kind=c_double), DIMENSION(*)         :: eigenvalues
         END SUBROUTINE cp_fm_general_cusolver_c
      END INTERFACE
 
      CALL timeset(routinen, handle)
 
#if defined(__CUSOLVERMP)
      n = int(amatrix%matrix_struct%nrow_global, c_int)
      context => amatrix%matrix_struct%context
 
      ! Allocate eigenvalues_buffer
      ALLOCATE (eigenvalues_buffer(n))
 
      CALL cp_fm_general_cusolver_c( &
         fortran_comm=int(amatrix%matrix_struct%para_env%get_handle(), c_int), &
         a_matrix_desc=int(amatrix%matrix_struct%descriptor, c_int), &
         b_matrix_desc=int(bmatrix%matrix_struct%descriptor, c_int), &
         nprow=int(context%num_pe(1), c_int), &
         npcol=int(context%num_pe(2), c_int), &
         myprow=int(context%mepos(1), c_int), &
         mypcol=int(context%mepos(2), c_int), &
         n=n, &
         amatrix=amatrix%local_data, &
         bmatrix=bmatrix%local_data, &
         eigenvectors=eigenvectors%local_data, &
         eigenvalues=eigenvalues_buffer)
 
      nmo = SIZE(eigenvalues)
      eigenvalues(1:nmo) = eigenvalues_buffer(1:nmo)
 
      DEALLOCATE (eigenvalues_buffer)
#else
      mark_used(amatrix)
      mark_used(bmatrix)
      mark_used(eigenvectors)
      eigenvalues = 0.0_dp
      mark_used(n)
      mark_used(nmo)
      mark_used(eigenvalues_buffer)
      mark_used(context)
      cpabort("CP2K compiled without the cuSOLVERMp library.")
#endif
 
      CALL timestop(handle)
   END SUBROUTINE cp_fm_general_cusolver
 
END MODULE cp_fm_cusolver_api