From b10eef3641fc83e24146fff93f7fddb2ca147bd3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ole=20Sch=C3=BCtt?= Date: Sun, 2 Jun 2024 20:26:42 +0200 Subject: [PATCH] Remove keep_sparsity option from dbcsr_complete_redistribute --- src/almo_scf.F | 6 ++---- src/almo_scf_optimizer.F | 16 ++++++++-------- src/almo_scf_qs.F | 26 +++++++++++--------------- src/cp_dbcsr_operations.F | 21 +++++++++++++++++---- src/dbx/cp_dbcsr_api.F | 5 ++--- 5 files changed, 40 insertions(+), 34 deletions(-) diff --git a/src/almo_scf.F b/src/almo_scf.F index 2229f85690..921ace8e4d 100644 --- a/src/almo_scf.F +++ b/src/almo_scf.F @@ -614,8 +614,7 @@ SUBROUTINE almo_scf_initial_guess(qs_env, almo_scf_env) DO ispin = 1, nspins ! copy the atomic-block dm into matrix_p_blk CALL matrix_qs_to_almo(rho_ao(ispin)%matrix, & - almo_scf_env%matrix_p_blk(ispin), almo_scf_env%mat_distr_aos, & - .FALSE.) + almo_scf_env%matrix_p_blk(ispin), almo_scf_env%mat_distr_aos) CALL dbcsr_filter(almo_scf_env%matrix_p_blk(ispin), & almo_scf_env%eps_filter) END DO ! ispin @@ -1228,8 +1227,7 @@ SUBROUTINE almo_scf_init_ao_overlap(matrix_s, almo_scf_env) CALL dbcsr_set(almo_scf_env%matrix_s_blk(1), 0.0_dp) CALL dbcsr_add_on_diag(almo_scf_env%matrix_s_blk(1), 1.0_dp) ELSE - CALL matrix_qs_to_almo(matrix_s, almo_scf_env%matrix_s(1), & - almo_scf_env%mat_distr_aos, .FALSE.) + CALL matrix_qs_to_almo(matrix_s, almo_scf_env%matrix_s(1), almo_scf_env%mat_distr_aos) CALL dbcsr_copy(almo_scf_env%matrix_s_blk(1), & almo_scf_env%matrix_s(1), keep_sparsity=.TRUE.) END IF diff --git a/src/almo_scf_optimizer.F b/src/almo_scf_optimizer.F index 907a6ea4c0..1a7d33ce1b 100644 --- a/src/almo_scf_optimizer.F +++ b/src/almo_scf_optimizer.F @@ -1043,8 +1043,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & CALL compute_berry_operator(qs_env, cell, op_sm_set_qs, dim_op) - !CALL matrix_qs_to_almo(op_sm_set_qs, op_sm_set_almo, & - ! almo_scf_env%mat_distr_aos, .FALSE.) + !CALL matrix_qs_to_almo(op_sm_set_qs, op_sm_set_almo, almo_scf_env%mat_distr_aos) END IF @@ -1208,8 +1207,8 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & DO idim0 = 1, SIZE(op_sm_set_qs, 2) ! this loop is over miller ind DO reim = 1, SIZE(op_sm_set_qs, 1) ! this loop is over Re/Im - CALL matrix_qs_to_almo(op_sm_set_qs(reim, idim0)%matrix, op_sm_set_almo(reim, idim0)%matrix, & - almo_scf_env%mat_distr_aos, .FALSE.) + CALL matrix_qs_to_almo(op_sm_set_qs(reim, idim0)%matrix, & + op_sm_set_almo(reim, idim0)%matrix, almo_scf_env%mat_distr_aos) CALL dbcsr_multiply("N", "N", 1.0_dp, & op_sm_set_almo(reim, idim0)%matrix, & @@ -1325,8 +1324,9 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & DO reim = 1, SIZE(op_sm_set_qs, 1) ! this loop is over Re/Im - !CALL matrix_qs_to_almo(op_sm_set_qs(reim, idim0)%matrix, op_sm_set_almo(reim, idim0)%matrix, & - ! almo_scf_env%mat_distr_aos, .FALSE.) + !CALL matrix_qs_to_almo(op_sm_set_qs(reim, idim0)%matrix, + ! op_sm_set_almo(reim, idim0)%matrix, & + ! almo_scf_env%mat_distr_aos) CALL dbcsr_multiply("N", "N", 1.0_dp, & op_sm_set_almo(reim, idim0)%matrix, & matrix_t_out(ispin), & @@ -2310,8 +2310,8 @@ SUBROUTINE almo_scf_construct_nlmos(qs_env, optimizer, & DO reim = 1, SIZE(op_sm_set_qs, 1) ! this loop is over Re/Im - CALL matrix_qs_to_almo(op_sm_set_qs(reim, idim0)%matrix, op_sm_set_almo(reim, idim0)%matrix, & - mat_distr_aos, .FALSE.) + CALL matrix_qs_to_almo(op_sm_set_qs(reim, idim0)%matrix, & + op_sm_set_almo(reim, idim0)%matrix, mat_distr_aos) CALL dbcsr_multiply("N", "N", 1.0_dp, & op_sm_set_almo(reim, idim0)%matrix, & diff --git a/src/almo_scf_qs.F b/src/almo_scf_qs.F index 21e110d6eb..1e5fcf1bab 100644 --- a/src/almo_scf_qs.F +++ b/src/almo_scf_qs.F @@ -414,16 +414,14 @@ END SUBROUTINE matrix_almo_create !> \param matrix_qs ... !> \param matrix_almo ... !> \param mat_distr_aos ... -!> \param keep_sparsity ... !> \par History !> 2011.06 created [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin ! ************************************************************************************************** - SUBROUTINE matrix_qs_to_almo(matrix_qs, matrix_almo, mat_distr_aos, keep_sparsity) + SUBROUTINE matrix_qs_to_almo(matrix_qs, matrix_almo, mat_distr_aos) TYPE(dbcsr_type) :: matrix_qs, matrix_almo INTEGER :: mat_distr_aos - LOGICAL, INTENT(IN) :: keep_sparsity CHARACTER(len=*), PARAMETER :: routineN = 'matrix_qs_to_almo' @@ -436,12 +434,10 @@ SUBROUTINE matrix_qs_to_almo(matrix_qs, matrix_almo, mat_distr_aos, keep_sparsit SELECT CASE (mat_distr_aos) CASE (almo_mat_distr_atomic) ! automatic data_type conversion - CALL dbcsr_copy(matrix_almo, matrix_qs, & - keep_sparsity=keep_sparsity) + CALL dbcsr_copy(matrix_almo, matrix_qs) CASE (almo_mat_distr_molecular) ! desymmetrize the qs matrix - CALL dbcsr_create(matrix_qs_nosym, template=matrix_qs, & - matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(matrix_qs_nosym, template=matrix_qs, matrix_type=dbcsr_type_no_symmetry) CALL dbcsr_desymmetrize(matrix_qs, matrix_qs_nosym) ! perform the magic complete_redistribute @@ -452,8 +448,7 @@ SUBROUTINE matrix_qs_to_almo(matrix_qs, matrix_almo, mat_distr_aos, keep_sparsit ! complete_redistribute. RZK-warning it should be later corrected by calling ! dbcsr_set to 0.0 from within complete_redistribute CALL dbcsr_set(matrix_almo, 0.0_dp) - CALL dbcsr_complete_redistribute(matrix_qs_nosym, matrix_almo, & - keep_sparsity=keep_sparsity); + CALL dbcsr_complete_redistribute(matrix_qs_nosym, matrix_almo) CALL dbcsr_release(matrix_qs_nosym) CASE DEFAULT @@ -480,6 +475,7 @@ SUBROUTINE matrix_almo_to_qs(matrix_almo, matrix_qs, mat_distr_aos) CHARACTER(len=*), PARAMETER :: routineN = 'matrix_almo_to_qs' INTEGER :: handle + TYPE(dbcsr_type) :: matrix_almo_redist CALL timeset(routineN, handle) ! RZK-warning if it's not a N(AO)xN(AO) matrix then stop @@ -488,8 +484,11 @@ SUBROUTINE matrix_almo_to_qs(matrix_almo, matrix_qs, mat_distr_aos) CASE (almo_mat_distr_atomic) CALL dbcsr_copy(matrix_qs, matrix_almo, keep_sparsity=.TRUE.) CASE (almo_mat_distr_molecular) + CALL dbcsr_create(matrix_almo_redist, template=matrix_qs) + CALL dbcsr_complete_redistribute(matrix_almo, matrix_almo_redist) CALL dbcsr_set(matrix_qs, 0.0_dp) - CALL dbcsr_complete_redistribute(matrix_almo, matrix_qs, keep_sparsity=.TRUE.) + CALL dbcsr_copy(matrix_qs, matrix_almo_redist, keep_sparsity=.TRUE.) + CALL dbcsr_release(matrix_almo_redist) CASE DEFAULT CPABORT("") END SELECT @@ -553,8 +552,7 @@ SUBROUTINE init_almo_ks_matrix_via_qs(qs_env, matrix_ks, mat_distr_aos, eps_filt ! copy to ALMO DO ispin = 1, nspin - CALL matrix_qs_to_almo(matrix_qs_ks(ispin)%matrix, & - matrix_ks(ispin), mat_distr_aos, .FALSE.) + CALL matrix_qs_to_almo(matrix_qs_ks(ispin)%matrix, matrix_ks(ispin), mat_distr_aos) CALL dbcsr_filter(matrix_ks(ispin), eps_filter) END DO @@ -788,9 +786,7 @@ SUBROUTINE almo_dm_to_almo_ks(qs_env, matrix_p, matrix_ks, energy_total, eps_fil ! get KS matrix from the QS env and convert to the ALMO format CALL get_qs_env(qs_env, matrix_ks=matrix_qs_ks) DO ispin = 1, nspins - CALL matrix_qs_to_almo(matrix_qs_ks(ispin)%matrix, & - matrix_ks(ispin), & - mat_distr_aos, .FALSE.) + CALL matrix_qs_to_almo(matrix_qs_ks(ispin)%matrix, matrix_ks(ispin), mat_distr_aos) CALL dbcsr_filter(matrix_ks(ispin), eps_filter) END DO diff --git a/src/cp_dbcsr_operations.F b/src/cp_dbcsr_operations.F index efc448af8b..d124b1adc6 100644 --- a/src/cp_dbcsr_operations.F +++ b/src/cp_dbcsr_operations.F @@ -112,19 +112,32 @@ MODULE cp_dbcsr_operations !> \version 2.0 ! ************************************************************************************************** SUBROUTINE copy_${fm}$_to_dbcsr(fm, matrix, keep_sparsity) - TYPE(cp_${fm}$_type), INTENT(IN) :: fm - TYPE(dbcsr_type), INTENT(INOUT) :: matrix + TYPE(cp_${fm}$_type), INTENT(IN) :: fm + TYPE(dbcsr_type), INTENT(INOUT) :: matrix LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity CHARACTER(LEN=*), PARAMETER :: routineN = 'copy_${fm}$_to_dbcsr' - TYPE(dbcsr_type) :: bc_mat + TYPE(dbcsr_type) :: bc_mat, redist_mat INTEGER :: handle + LOGICAL :: my_keep_sparsity CALL timeset(routineN, handle) + my_keep_sparsity = .FALSE. + IF (PRESENT(keep_sparsity)) my_keep_sparsity = keep_sparsity + CALL copy_${fm}$_to_dbcsr_bc(fm, bc_mat) - CALL dbcsr_complete_redistribute(bc_mat, matrix, keep_sparsity=keep_sparsity) + + IF (my_keep_sparsity) THEN + CALL dbcsr_create(redist_mat, template=matrix) + CALL dbcsr_complete_redistribute(bc_mat, redist_mat) + CALL dbcsr_copy(matrix, redist_mat, keep_sparsity=.TRUE.) + CALL dbcsr_release(redist_mat) + ELSE + CALL dbcsr_complete_redistribute(bc_mat, matrix) + END IF + CALL dbcsr_release(bc_mat) CALL timestop(handle) diff --git a/src/dbx/cp_dbcsr_api.F b/src/dbx/cp_dbcsr_api.F index c76dfd52f9..f4882941ac 100644 --- a/src/dbx/cp_dbcsr_api.F +++ b/src/dbx/cp_dbcsr_api.F @@ -463,12 +463,11 @@ SUBROUTINE dbcsr_clear(matrix) ! ************************************************************************************************** !> \brief ... ! ************************************************************************************************** - SUBROUTINE dbcsr_complete_redistribute(matrix, redist, keep_sparsity) + SUBROUTINE dbcsr_complete_redistribute(matrix, redist) TYPE(dbcsr_type), INTENT(IN) :: matrix TYPE(dbcsr_type), INTENT(INOUT) :: redist - LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity - CALL dbcsr_complete_redistribute_prv(matrix%prv, redist%prv, keep_sparsity) + CALL dbcsr_complete_redistribute_prv(matrix%prv, redist%prv) END SUBROUTINE dbcsr_complete_redistribute ! **************************************************************************************************