47#include "./base/base_uses.f90"
51 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_density_matrices'
59 MODULE PROCEDURE calculate_dm_sparse
63 MODULE PROCEDURE calculate_w_matrix_1, calculate_w_matrix_roks
80 SUBROUTINE calculate_dm_sparse(mo_set, density_matrix, use_dbcsr, retain_sparsity)
84 LOGICAL,
INTENT(IN),
OPTIONAL :: use_dbcsr, retain_sparsity
86 CHARACTER(len=*),
PARAMETER :: routineN =
'calculate_dm_sparse'
89 LOGICAL :: my_retain_sparsity, my_use_dbcsr
90 REAL(KIND=
dp) :: alpha
94 CALL timeset(routinen, handle)
96 my_use_dbcsr = .false.
97 IF (
PRESENT(use_dbcsr)) my_use_dbcsr = use_dbcsr
98 my_retain_sparsity = .true.
99 IF (
PRESENT(retain_sparsity)) my_retain_sparsity = retain_sparsity
100 IF (my_use_dbcsr)
THEN
101 IF (.NOT.
ASSOCIATED(mo_set%mo_coeff_b))
THEN
102 cpabort(
"mo_coeff_b NOT ASSOCIATED")
108 IF (.NOT. mo_set%uniform_occupation)
THEN
109 IF (my_use_dbcsr)
THEN
113 CALL dbcsr_multiply(
"N",
"T", 1.0_dp, mo_set%mo_coeff_b, dbcsr_tmp, &
114 1.0_dp, density_matrix, retain_sparsity=my_retain_sparsity, &
118 CALL cp_fm_create(fm_tmp, mo_set%mo_coeff%matrix_struct)
123 matrix_v=mo_set%mo_coeff, &
130 IF (my_use_dbcsr)
THEN
131 CALL dbcsr_multiply(
"N",
"T", mo_set%maxocc, mo_set%mo_coeff_b, mo_set%mo_coeff_b, &
132 1.0_dp, density_matrix, retain_sparsity=my_retain_sparsity, &
135 alpha = mo_set%maxocc
137 matrix_v=mo_set%mo_coeff, &
143 CALL timestop(handle)
145 END SUBROUTINE calculate_dm_sparse
159 SUBROUTINE calculate_w_matrix_1(mo_set, w_matrix)
164 CHARACTER(len=*),
PARAMETER :: routineN =
'calculate_w_matrix_1'
166 INTEGER :: handle, imo
167 REAL(KIND=
dp),
DIMENSION(:),
POINTER :: eigocc
170 CALL timeset(routinen, handle)
173 CALL cp_fm_create(weighted_vectors, mo_set%mo_coeff%matrix_struct,
"weighted_vectors")
174 CALL cp_fm_to_fm(mo_set%mo_coeff, weighted_vectors)
177 ALLOCATE (eigocc(mo_set%homo))
179 DO imo = 1, mo_set%homo
180 eigocc(imo) = mo_set%eigenvalues(imo)*mo_set%occupation_numbers(imo)
186 matrix_v=mo_set%mo_coeff, &
187 matrix_g=weighted_vectors, &
192 CALL timestop(handle)
194 END SUBROUTINE calculate_w_matrix_1
212 TYPE(
dbcsr_type),
POINTER :: mo_deriv, w_matrix, s_matrix
214 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_w_matrix_ot'
215 LOGICAL,
PARAMETER :: check_gradient = .false., &
218 INTEGER :: handle, iounit, ncol_global, nrow_global
219 REAL(kind=
dp),
DIMENSION(:),
POINTER :: occupation_numbers, scaling_factor
221 TYPE(
cp_fm_type) :: gradient, h_block, h_block_t, &
225 CALL timeset(routinen, handle)
226 NULLIFY (fm_struct_tmp)
229 ncol_global=ncol_global, &
230 nrow_global=nrow_global)
232 CALL cp_fm_create(weighted_vectors, mo_set%mo_coeff%matrix_struct,
"weighted_vectors")
233 CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol_global, ncol_global=ncol_global, &
234 para_env=mo_set%mo_coeff%matrix_struct%para_env, &
235 context=mo_set%mo_coeff%matrix_struct%context)
236 CALL cp_fm_create(h_block, fm_struct_tmp, name=
"h block")
237 IF (do_symm)
CALL cp_fm_create(h_block_t, fm_struct_tmp, name=
"h block t")
240 CALL get_mo_set(mo_set=mo_set, occupation_numbers=occupation_numbers)
241 ALLOCATE (scaling_factor(
SIZE(occupation_numbers)))
242 scaling_factor = 2.0_dp*occupation_numbers
245 DEALLOCATE (scaling_factor)
249 CALL parallel_gemm(
'T',
'N', ncol_global, ncol_global, nrow_global, 0.5_dp, &
250 mo_set%mo_coeff, weighted_vectors, 0.0_dp, h_block)
260 CALL parallel_gemm(
'N',
'N', nrow_global, ncol_global, ncol_global, 1.0_dp, &
261 mo_set%mo_coeff, h_block, 0.0_dp, weighted_vectors)
265 matrix_v=mo_set%mo_coeff, &
266 matrix_g=weighted_vectors, &
269 IF (check_gradient)
THEN
270 CALL cp_fm_create(gradient, mo_set%mo_coeff%matrix_struct,
"gradient")
272 gradient, ncol_global)
274 ALLOCATE (scaling_factor(
SIZE(occupation_numbers)))
275 scaling_factor = 2.0_dp*occupation_numbers
278 DEALLOCATE (scaling_factor)
281 IF (logger%para_env%is_source())
THEN
283 WRITE (iounit, *)
" maxabs difference ", &
284 maxval(abs(weighted_vectors%local_data - 2.0_dp*gradient%local_data))
293 CALL timestop(handle)
306 SUBROUTINE calculate_w_matrix_roks(mo_set, matrix_ks, matrix_p, matrix_w)
308 TYPE(
dbcsr_type),
POINTER :: matrix_ks, matrix_p, matrix_w
310 CHARACTER(len=*),
PARAMETER :: routineN =
'calculate_w_matrix_roks'
312 INTEGER :: handle, nao
319 CALL timeset(routinen, handle)
326 CALL cp_fm_get_info(c, context=context, nrow_global=nao, para_env=para_env)
328 ncol_global=nao, para_env=para_env)
329 CALL cp_fm_create(ks, fm_struct, name=
"Kohn-Sham matrix")
336 CALL cp_fm_symm(
"L",
"U", nao, nao, 1.0_dp, ks, p, 0.0_dp, work)
337 CALL parallel_gemm(
"T",
"N", nao, nao, nao, 1.0_dp, p, work, 0.0_dp, ks)
345 CALL timestop(handle)
347 END SUBROUTINE calculate_w_matrix_roks
364 TYPE(
dbcsr_type),
POINTER :: ks_matrix, w_matrix
366 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_wz_matrix'
368 INTEGER :: handle, ncol, nocc, nrow
372 CALL timeset(routinen, handle)
389 CALL cp_fm_get_info(matrix=mo_set%mo_coeff, ncol_global=ncol, nrow_global=nrow)
391 CALL cp_fm_create(scrv, mo_set%mo_coeff%matrix_struct,
"scr vectors")
393 para_env=mo_set%mo_coeff%matrix_struct%para_env, &
394 context=mo_set%mo_coeff%matrix_struct%context)
398 CALL parallel_gemm(
"T",
"N", nocc, nocc, nrow, 1.0_dp, mo_set%mo_coeff, scrv, 0.0_dp, ksmat)
399 CALL parallel_gemm(
"N",
"N", nrow, nocc, nocc, 1.0_dp, mo_set%mo_coeff, ksmat, 0.0_dp, scrv)
405 CALL timestop(handle)
425 REAL(kind=
dp),
INTENT(IN) :: focc
426 INTEGER,
INTENT(IN) :: nocc
428 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_whz_matrix'
430 INTEGER :: handle, nao, norb
431 REAL(kind=
dp) :: falpha
435 CALL timeset(routinen, handle)
440 CALL cp_fm_get_info(hcvec, matrix_struct=fm_struct, nrow_global=nao, ncol_global=norb)
441 cpassert(nocc <= norb .AND. nocc > 0)
444 ncol_global=norb, para_env=fm_struct%para_env)
449 CALL parallel_gemm(
"T",
"N", norb, norb, nao, 1.0_dp, c0vec, hcvec, 0.0_dp, chcmat)
450 CALL parallel_gemm(
"N",
"N", nao, norb, norb, 1.0_dp, c0vec, chcmat, 0.0_dp, hcvec)
457 CALL timestop(handle)
474 TYPE(
dbcsr_type),
POINTER :: ks_matrix, w_matrix
476 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_wx_matrix'
478 INTEGER :: handle, ncol, nrow
482 CALL timeset(routinen, handle)
484 CALL cp_fm_get_info(matrix=mos_occ, ncol_global=ncol, nrow_global=nrow)
485 CALL cp_fm_create(scrv, mos_occ%matrix_struct,
"scr vectors")
487 para_env=mos_occ%matrix_struct%para_env, &
488 context=mos_occ%matrix_struct%context)
492 CALL parallel_gemm(
"T",
"N", ncol, ncol, nrow, 1.0_dp, mos_occ, scrv, 0.0_dp, ksmat)
493 CALL parallel_gemm(
"N",
"N", nrow, ncol, ncol, 1.0_dp, xvec, ksmat, 0.0_dp, scrv)
498 CALL timestop(handle)
517 TYPE(
dbcsr_type),
POINTER :: s_matrix, ks_matrix, w_matrix
518 REAL(kind=
dp),
INTENT(IN) :: eval
520 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_xwx_matrix'
522 INTEGER :: handle, ncol, nrow
526 CALL timeset(routinen, handle)
528 CALL cp_fm_get_info(matrix=mos_occ, ncol_global=ncol, nrow_global=nrow)
529 CALL cp_fm_create(scrv, mos_occ%matrix_struct,
"scr vectors")
531 para_env=mos_occ%matrix_struct%para_env, &
532 context=mos_occ%matrix_struct%context)
538 CALL parallel_gemm(
"T",
"N", ncol, ncol, nrow, 1.0_dp, xvec, scrv, 0.0_dp, xsxmat)
540 CALL parallel_gemm(
"N",
"N", nrow, ncol, ncol, 1.0_dp, mos_occ, xsxmat, 0.0_dp, scrv)
546 CALL timestop(handle)
methods related to the blacs parallel environment
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, matrix_c, first_row, last_row, first_column, last_column, first_k, last_k, retain_sparsity, filter_eps, flop)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_release(matrix)
...
subroutine, public dbcsr_scale_by_vector(matrix, alpha, side)
Scales the rows/columns of given matrix.
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
subroutine, public cp_dbcsr_plus_fm_fm_t(sparse_matrix, matrix_v, matrix_g, ncol, alpha, keep_sparsity, symmetry_mode)
performs the multiplication sparse_matrix+dense_mat*dens_mat^T if matrix_g is not explicitly given,...
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
basic linear algebra operations for full matrices
subroutine, public cp_fm_column_scale(matrixa, scaling)
scales column i of matrix a with scaling(i)
subroutine, public cp_fm_transpose(matrix, matrixt)
transposes a matrix matrixt = matrix ^ T
subroutine, public cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b)
calc A <- alpha*A + beta*B optimized for alpha == 1.0 (just add beta*B) and beta == 0....
subroutine, public cp_fm_uplo_to_full(matrix, work, uplo)
given a triangular matrix according to uplo, computes the corresponding full matrix
subroutine, public cp_fm_symm(side, uplo, m, n, alpha, matrix_a, matrix_b, beta, matrix_c)
computes matrix_c = beta * matrix_c + alpha * matrix_a * matrix_b computes matrix_c = beta * matrix_c...
represent the structure of a full matrix
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
various routines to log and control the output. The idea is that decisions about where to log should ...
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Defines the basic variable types.
integer, parameter, public dp
Interface to the message passing library MPI.
basic linear algebra operations for full matrixes
collects routines that calculate density matrices
subroutine, public calculate_whz_matrix(c0vec, hzm, w_matrix, focc, nocc)
Calculate the Wz matrix from the MO eigenvectors, MO eigenvalues, and the MO occupation numbers....
subroutine, public calculate_wx_matrix(mos_occ, xvec, ks_matrix, w_matrix)
Calculate the excited state W matrix from the MO eigenvectors, KS matrix.
subroutine, public calculate_w_matrix_ot(mo_set, mo_deriv, w_matrix, s_matrix)
Calculate the W matrix from the MO coefs, MO derivs could overwrite the mo_derivs for increased memor...
subroutine, public calculate_wz_matrix(mo_set, psi1, ks_matrix, w_matrix)
Calculate the response W matrix from the MO eigenvectors, MO eigenvalues, and the MO occupation numbe...
subroutine, public calculate_xwx_matrix(mos_occ, xvec, s_matrix, ks_matrix, w_matrix, eval)
Calculate the excited state W matrix from the MO eigenvectors, KS matrix.
Definition and initialisation of the mo data type.
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
keeps the information about the structure of a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
stores all the informations relevant to an mpi environment