Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Wrapper for cuSOLVERMp
10 : !> \author Ole Schuett
11 : ! **************************************************************************************************
12 : MODULE cp_fm_cusolver_api
13 : USE ISO_C_BINDING, ONLY: C_DOUBLE,&
14 : C_INT
15 : USE cp_blacs_env, ONLY: cp_blacs_env_type
16 : USE cp_fm_types, ONLY: cp_fm_type
17 : USE kinds, ONLY: dp
18 : #include "../base/base_uses.f90"
19 :
20 : IMPLICIT NONE
21 :
22 : PRIVATE
23 :
24 : PUBLIC :: cp_fm_diag_cusolver
25 : PUBLIC :: cp_fm_general_cusolver
26 :
27 : CONTAINS
28 :
29 : ! **************************************************************************************************
30 : !> \brief Driver routine to diagonalize a FM matrix with the cuSOLVERMp library.
31 : !> \param matrix the matrix that is diagonalized
32 : !> \param eigenvectors eigenvectors of the input matrix
33 : !> \param eigenvalues eigenvalues of the input matrix
34 : !> \author Ole Schuett
35 : ! **************************************************************************************************
36 0 : SUBROUTINE cp_fm_diag_cusolver(matrix, eigenvectors, eigenvalues)
37 : TYPE(cp_fm_type), INTENT(IN) :: matrix, eigenvectors
38 : REAL(KIND=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
39 :
40 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_fm_diag_cusolver'
41 :
42 : INTEGER :: handle, n, nmo
43 0 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues_buffer
44 : TYPE(cp_blacs_env_type), POINTER :: context
45 : INTERFACE
46 : SUBROUTINE cp_fm_diag_cusolver_c(fortran_comm, matrix_desc, &
47 : nprow, npcol, myprow, mypcol, &
48 : n, matrix, eigenvectors, eigenvalues) &
49 : BIND(C, name="cp_fm_diag_cusolver")
50 : IMPORT :: C_INT, C_DOUBLE
51 : INTEGER(kind=C_INT), VALUE :: fortran_comm
52 : INTEGER(kind=C_INT), DIMENSION(*) :: matrix_desc
53 : INTEGER(kind=C_INT), VALUE :: nprow
54 : INTEGER(kind=C_INT), VALUE :: npcol
55 : INTEGER(kind=C_INT), VALUE :: myprow
56 : INTEGER(kind=C_INT), VALUE :: mypcol
57 : INTEGER(kind=C_INT), VALUE :: n
58 : REAL(kind=C_DOUBLE), DIMENSION(*) :: matrix
59 : REAL(kind=C_DOUBLE), DIMENSION(*) :: eigenvectors
60 : REAL(kind=C_DOUBLE), DIMENSION(*) :: eigenvalues
61 : END SUBROUTINE cp_fm_diag_cusolver_c
62 : END INTERFACE
63 :
64 0 : CALL timeset(routineN, handle)
65 :
66 : #if defined(__CUSOLVERMP)
67 : n = matrix%matrix_struct%nrow_global
68 : context => matrix%matrix_struct%context
69 :
70 : ! The passed eigenvalues array might be smaller than n.
71 : ALLOCATE (eigenvalues_buffer(n))
72 :
73 : CALL cp_fm_diag_cusolver_c( &
74 : fortran_comm=matrix%matrix_struct%para_env%get_handle(), &
75 : matrix_desc=matrix%matrix_struct%descriptor, &
76 : nprow=context%num_pe(1), &
77 : npcol=context%num_pe(2), &
78 : myprow=context%mepos(1), &
79 : mypcol=context%mepos(2), &
80 : n=matrix%matrix_struct%nrow_global, &
81 : matrix=matrix%local_data, &
82 : eigenvectors=eigenvectors%local_data, &
83 : eigenvalues=eigenvalues_buffer)
84 :
85 : nmo = SIZE(eigenvalues)
86 : eigenvalues(1:nmo) = eigenvalues_buffer(1:nmo)
87 :
88 : #else
89 : MARK_USED(matrix)
90 : MARK_USED(eigenvectors)
91 0 : eigenvalues = 0.0_dp
92 : MARK_USED(n)
93 : MARK_USED(nmo)
94 : MARK_USED(eigenvalues_buffer)
95 : MARK_USED(context)
96 0 : CPABORT("CP2K compiled without the cuSOLVERMp library.")
97 : #endif
98 :
99 0 : CALL timestop(handle)
100 0 : END SUBROUTINE cp_fm_diag_cusolver
101 :
102 : ! **************************************************************************************************
103 : !> \brief Driver routine to solve generalized eigenvalue problem A*x = lambda*B*x with cuSOLVERMp.
104 : !> \param aMatrix the first matrix for the generalized eigenvalue problem
105 : !> \param bMatrix the second matrix for the generalized eigenvalue problem
106 : !> \param eigenvectors eigenvectors of the input matrix
107 : !> \param eigenvalues eigenvalues of the input matrix
108 : ! **************************************************************************************************
109 0 : SUBROUTINE cp_fm_general_cusolver(aMatrix, bMatrix, eigenvectors, eigenvalues)
110 : USE ISO_C_BINDING, ONLY: C_INT, C_DOUBLE
111 : TYPE(cp_fm_type), INTENT(IN) :: aMatrix, bMatrix, eigenvectors
112 : REAL(KIND=dp), DIMENSION(:), INTENT(OUT) :: eigenvalues
113 :
114 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_fm_general_cusolver'
115 :
116 : INTEGER(kind=C_INT) :: handle, n, nmo
117 0 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues_buffer
118 : TYPE(cp_blacs_env_type), POINTER :: context
119 : INTERFACE
120 : SUBROUTINE cp_fm_general_cusolver_c(fortran_comm, a_matrix_desc, b_matrix_desc, &
121 : nprow, npcol, myprow, mypcol, &
122 : n, aMatrix, bMatrix, eigenvectors, eigenvalues) &
123 : BIND(C, name="cp_fm_diag_cusolver_sygvd")
124 : IMPORT :: C_INT, C_DOUBLE
125 : INTEGER(kind=C_INT), VALUE :: fortran_comm
126 : INTEGER(kind=C_INT), DIMENSION(*) :: a_matrix_desc, b_matrix_desc
127 : INTEGER(kind=C_INT), VALUE :: nprow
128 : INTEGER(kind=C_INT), VALUE :: npcol
129 : INTEGER(kind=C_INT), VALUE :: myprow
130 : INTEGER(kind=C_INT), VALUE :: mypcol
131 : INTEGER(kind=C_INT), VALUE :: n
132 : REAL(kind=C_DOUBLE), DIMENSION(*) :: aMatrix
133 : REAL(kind=C_DOUBLE), DIMENSION(*) :: bMatrix
134 : REAL(kind=C_DOUBLE), DIMENSION(*) :: eigenvectors
135 : REAL(kind=C_DOUBLE), DIMENSION(*) :: eigenvalues
136 : END SUBROUTINE cp_fm_general_cusolver_c
137 : END INTERFACE
138 :
139 0 : CALL timeset(routineN, handle)
140 :
141 : #if defined(__CUSOLVERMP)
142 : n = INT(aMatrix%matrix_struct%nrow_global, C_INT)
143 : context => aMatrix%matrix_struct%context
144 :
145 : ! Allocate eigenvalues_buffer
146 : ALLOCATE (eigenvalues_buffer(n))
147 :
148 : CALL cp_fm_general_cusolver_c( &
149 : fortran_comm=INT(aMatrix%matrix_struct%para_env%get_handle(), C_INT), &
150 : a_matrix_desc=INT(aMatrix%matrix_struct%descriptor, C_INT), &
151 : b_matrix_desc=INT(bMatrix%matrix_struct%descriptor, C_INT), &
152 : nprow=INT(context%num_pe(1), C_INT), &
153 : npcol=INT(context%num_pe(2), C_INT), &
154 : myprow=INT(context%mepos(1), C_INT), &
155 : mypcol=INT(context%mepos(2), C_INT), &
156 : n=n, &
157 : aMatrix=aMatrix%local_data, &
158 : bMatrix=bMatrix%local_data, &
159 : eigenvectors=eigenvectors%local_data, &
160 : eigenvalues=eigenvalues_buffer)
161 :
162 : nmo = SIZE(eigenvalues)
163 : eigenvalues(1:nmo) = eigenvalues_buffer(1:nmo)
164 :
165 : DEALLOCATE (eigenvalues_buffer)
166 : #else
167 : MARK_USED(aMatrix)
168 : MARK_USED(bMatrix)
169 : MARK_USED(eigenvectors)
170 0 : eigenvalues = 0.0_dp
171 : MARK_USED(n)
172 : MARK_USED(nmo)
173 : MARK_USED(eigenvalues_buffer)
174 : MARK_USED(context)
175 0 : CPABORT("CP2K compiled without the cuSOLVERMp library.")
176 : #endif
177 :
178 0 : CALL timestop(handle)
179 0 : END SUBROUTINE cp_fm_general_cusolver
180 :
181 : END MODULE cp_fm_cusolver_api
|