Skip to content

Commit

Permalink
Refactor mo_set_p_type and cp_fm_p_type (#2400)
Browse files Browse the repository at this point in the history 
* Refactor cp_fm_pool_create_fm

* Refactor cp_fm_pool_give_back_fm

* Add intents

* Switch POINTERs to non-POINTERs

* Add more ways to allocate arrays of cp_fm(_p)_type with pools

* Add more ways to allocate arrays of cp_fm(_p)_type with pools

* Use fypp macros

* Add symmetry mode to cp_dbcsr_plus_fm_fm_t

Prevents unnecessary redistribution steps

* Refactor memory pool in mp2

* Remove some of the memory pools

* Add variants of cp_fm_pools_create_fm_vect

* Add variants of cp_fm_vect_dealloc

* Refactor cp_fm_p_type in optimize_basis

* Refactor cp_fm_p_type in qs_p_env_types

* Refactor deallocate_mo_set

* Refactor allocate_mo_set

* Continue

* Remove some branches

* Refactor duplicate_mo_set

* Refactor qs_mo_types

* Replace mo_set_p_type with mo_set_type in most occasions

* Refactor allocate_mo_set

* Continue with MP2/EXX/TIP/XAS

* optbas, qs_active, qs_scf

* Refactor cp_fm_p_type with ADMM

* Refactor cp_fm_p_type in rpa

* Refactor mp2_cphf

* Refactor cp_fm_p_type in MP2 and RPA
  • Loading branch information
@fstein93
fstein93 committed Nov 17, 2022
1 parent 8538f92 commit 60a779e
Show file tree
Hide file tree
Showing 140 changed files with 2,805 additions and 3,029 deletions.
411 changes: 204 additions & 207 deletions src/admm_methods.F
View file

Large diffs are not rendered by default.

197 changes: 60 additions & 137 deletions src/admm_types.F
View file

Large diffs are not rendered by default.

24 changes: 12 additions & 12 deletions src/admm_utils.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -70,19 +70,19 @@ SUBROUTINE admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix)

CALL dbcsr_copy(work, ks_matrix)
CALL dbcsr_set(work, 0.0_dp)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin), work, keep_sparsity=.TRUE.)

CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)

! ** calculate A^T*H_tilde*A
CALL parallel_gemm('N', 'N', nao_aux_fit, nao_orb, nao_aux_fit, &
1.0_dp, admm_env%K(ispin)%matrix, admm_env%A, 0.0_dp, &
1.0_dp, admm_env%K(ispin), admm_env%A, 0.0_dp, &
admm_env%work_aux_orb)
CALL parallel_gemm('T', 'N', nao_orb, nao_orb, nao_aux_fit, &
1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
admm_env%H_corr(ispin)%matrix)
admm_env%H_corr(ispin))

CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)

CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
CALL dbcsr_deallocate_matrix(work)
Expand All @@ -95,17 +95,17 @@ SUBROUTINE admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix)

CALL dbcsr_copy(work, ks_matrix)
CALL dbcsr_set(work, 0.0_dp)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin), work, keep_sparsity=.TRUE.)

! ** calculate A^T*H_tilde*A
CALL parallel_gemm('N', 'N', nao_aux_fit, nao_orb, nao_aux_fit, &
1.0_dp, admm_env%K(ispin)%matrix, admm_env%A, 0.0_dp, &
1.0_dp, admm_env%K(ispin), admm_env%A, 0.0_dp, &
admm_env%work_aux_orb)
CALL parallel_gemm('T', 'N', nao_orb, nao_orb, nao_aux_fit, &
1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
admm_env%H_corr(ispin)%matrix)
admm_env%H_corr(ispin))

CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)

CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
CALL dbcsr_deallocate_matrix(work)
Expand Down Expand Up @@ -144,14 +144,14 @@ SUBROUTINE admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix)

CALL dbcsr_copy(work, ks_matrix)
CALL dbcsr_set(work, 0.0_dp)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)

CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)

CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)

CALL dbcsr_set(work, 0.0_dp)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin), work, keep_sparsity=.TRUE.)

CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
CALL dbcsr_deallocate_matrix(work)
Expand All @@ -164,7 +164,7 @@ SUBROUTINE admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix)
CALL dbcsr_copy(work, ks_matrix)
CALL dbcsr_set(work, 0.0_dp)

CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)

CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)
CALL dbcsr_deallocate_matrix(work)
Expand Down
6 changes: 3 additions & 3 deletions src/almo_scf.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,7 @@ MODULE almo_scf
USE qs_initial_guess, ONLY: calculate_mopac_dm
USE qs_kind_types, ONLY: qs_kind_type
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type
mo_set_type
USE qs_rho_types, ONLY: qs_rho_get,&
qs_rho_type
USE qs_scf_post_scf, ONLY: qs_scf_compute_properties
Expand Down Expand Up @@ -2113,7 +2113,7 @@ SUBROUTINE almo_scf_post(qs_env, almo_scf_env)
TYPE(cp_fm_type), POINTER :: mo_coeff
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_w
TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: matrix_t_processed
TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos
TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
TYPE(qs_scf_env_type), POINTER :: scf_env
CALL timeset(routineN, handle)
Expand Down Expand Up @@ -2176,7 +2176,7 @@ SUBROUTINE almo_scf_post(qs_env, almo_scf_env)
DO ispin = 1, almo_scf_env%nspins
! Currently only fm version of mo_set is usable.
! First transform the matrix_t to fm version
CALL get_mo_set(mos(ispin)%mo_set, mo_coeff=mo_coeff)
CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff)
CALL copy_dbcsr_to_fm(matrix_t_processed(ispin), mo_coeff)
CALL dbcsr_release(matrix_t_processed(ispin))
END DO
Expand Down
11 changes: 7 additions & 4 deletions src/almo_scf_qs.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,8 +63,9 @@ MODULE almo_scf_qs
qs_ks_env_type,&
set_ks_env
USE qs_mo_types, ONLY: allocate_mo_set,&
deallocate_mo_set,&
init_mo_set,&
mo_set_p_type
mo_set_type
USE qs_neighbor_list_types, ONLY: get_iterator_info,&
neighbor_list_iterate,&
neighbor_list_iterator_create,&
Expand Down Expand Up @@ -580,7 +581,7 @@ SUBROUTINE construct_qs_mos(qs_env, almo_scf_env)
TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
TYPE(cp_fm_type) :: mo_fm_copy
TYPE(dft_control_type), POINTER :: dft_control
TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos
TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
TYPE(qs_scf_env_type), POINTER :: scf_env

CALL timeset(routineN, handle)
Expand All @@ -601,7 +602,9 @@ SUBROUTINE construct_qs_mos(qs_env, almo_scf_env)

! Currently only fm version of mo_set is usable.
! First transform the matrix_t to fm version
CALL allocate_mo_set(mo_set=mos(ispin)%mo_set, &
! Empty the containers to prevent memory leaks
CALL deallocate_mo_set(mos(ispin))
CALL allocate_mo_set(mo_set=mos(ispin), &
nao=nrow_fm, &
nmo=ncol_fm, &
nelectron=almo_scf_env%nelectrons_total, &
Expand All @@ -617,7 +620,7 @@ SUBROUTINE construct_qs_mos(qs_env, almo_scf_env)
CALL cp_fm_struct_release(fm_struct_tmp)
!CALL copy_dbcsr_to_fm(almo_scf_env%matrix_t(ispin), mo_fm_copy)

CALL init_mo_set(mos(ispin)%mo_set, fm_ref=mo_fm_copy, name='fm_mo')
CALL init_mo_set(mos(ispin), fm_ref=mo_fm_copy, name='fm_mo')

CALL cp_fm_release(mo_fm_copy)

Expand Down
61 changes: 53 additions & 8 deletions src/cp_dbcsr_operations.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -682,18 +682,24 @@ END SUBROUTINE match_col_sizes
!> \param alpha ...
!> \param keep_sparsity Determines if the sparsity of sparse_matrix is retained
!> by default it is TRUE
!> \param symmetry_mode There are the following modes
!> 1: sparse_matrix += 0.5*alpha*(v*g^T+g^T*v) (symmetric update)
!> -1: sparse_matrix += 0.5*alpha*(v*g^T-g^T*v) (skewsymmetric update)
!> else: sparse_matrix += alpha*v*g^T (no symmetry, default)
!> saves some redistribution steps
! **************************************************************************************************
SUBROUTINE cp_dbcsr_plus_fm_fm_t(sparse_matrix, matrix_v, matrix_g, ncol, alpha, keep_sparsity)
SUBROUTINE cp_dbcsr_plus_fm_fm_t(sparse_matrix, matrix_v, matrix_g, ncol, alpha, keep_sparsity, symmetry_mode)
TYPE(dbcsr_type), INTENT(INOUT) :: sparse_matrix
TYPE(cp_fm_type), INTENT(IN) :: matrix_v
TYPE(cp_fm_type), OPTIONAL, INTENT(IN) :: matrix_g
INTEGER, INTENT(IN) :: ncol
REAL(KIND=dp), INTENT(IN), OPTIONAL :: alpha
LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity
INTEGER, INTENT(IN), OPTIONAL :: symmetry_mode

CHARACTER(LEN=*), PARAMETER :: routineN = 'cp_dbcsr_plus_fm_fm_t_native'

INTEGER :: npcols, k, nao, timing_handle, data_type
INTEGER :: npcols, k, nao, timing_handle, data_type, my_symmetry_mode
INTEGER, DIMENSION(:), POINTER :: col_blk_size_left, &
col_dist_left, row_blk_size, row_dist
LOGICAL :: check_product, my_keep_sparsity
Expand All @@ -710,6 +716,10 @@ SUBROUTINE cp_dbcsr_plus_fm_fm_t(sparse_matrix, matrix_v, matrix_g, ncol, alpha,

my_keep_sparsity = .TRUE.
IF (PRESENT(keep_sparsity)) my_keep_sparsity = keep_sparsity

my_symmetry_mode = 0
IF (PRESENT(symmetry_mode)) my_symmetry_mode = symmetry_mode

NULLIFY (col_dist_left)

IF (ncol .GT. 0) THEN
Expand Down Expand Up @@ -755,10 +765,33 @@ SUBROUTINE cp_dbcsr_plus_fm_fm_t(sparse_matrix, matrix_v, matrix_g, ncol, alpha,
my_alpha = 1.0_dp
IF (PRESENT(alpha)) my_alpha = alpha
IF (PRESENT(matrix_g)) THEN
CALL dbcsr_multiply("N", "T", my_alpha, mat_v, mat_g, &
1.0_dp, sparse_matrix, &
retain_sparsity=my_keep_sparsity, &
last_k=ncol)
IF (my_symmetry_mode == 1) THEN
! Symmetric mode
CALL dbcsr_multiply("N", "T", 0.5_dp*my_alpha, mat_v, mat_g, &
1.0_dp, sparse_matrix, &
retain_sparsity=my_keep_sparsity, &
last_k=ncol)
CALL dbcsr_multiply("N", "T", 0.5_dp*my_alpha, mat_g, mat_v, &
1.0_dp, sparse_matrix, &
retain_sparsity=my_keep_sparsity, &
last_k=ncol)
ELSE IF (my_symmetry_mode == -1) THEN
! Skewsymmetric mode
CALL dbcsr_multiply("N", "T", 0.5_dp*my_alpha, mat_v, mat_g, &
1.0_dp, sparse_matrix, &
retain_sparsity=my_keep_sparsity, &
last_k=ncol)
CALL dbcsr_multiply("N", "T", -0.5_dp*my_alpha, mat_g, mat_v, &
1.0_dp, sparse_matrix, &
retain_sparsity=my_keep_sparsity, &
last_k=ncol)
ELSE
! Normal mode
CALL dbcsr_multiply("N", "T", my_alpha, mat_v, mat_g, &
1.0_dp, sparse_matrix, &
retain_sparsity=my_keep_sparsity, &
last_k=ncol)
END IF
ELSE
CALL dbcsr_multiply("N", "T", my_alpha, mat_v, mat_v, &
1.0_dp, sparse_matrix, &
Expand All @@ -768,8 +801,20 @@ SUBROUTINE cp_dbcsr_plus_fm_fm_t(sparse_matrix, matrix_v, matrix_g, ncol, alpha,

IF (check_product) THEN
IF (PRESENT(matrix_g)) THEN
CALL cp_fm_gemm("N", "T", nao, nao, ncol, my_alpha, matrix_v, matrix_g, &
1.0_dp, fm_matrix)
IF (my_symmetry_mode == 1) THEN
CALL cp_fm_gemm("N", "T", nao, nao, ncol, 0.5_dp*my_alpha, matrix_v, matrix_g, &
1.0_dp, fm_matrix)
CALL cp_fm_gemm("N", "T", nao, nao, ncol, 0.5_dp*my_alpha, matrix_g, matrix_v, &
1.0_dp, fm_matrix)
ELSE IF (my_symmetry_mode == -1) THEN
CALL cp_fm_gemm("N", "T", nao, nao, ncol, 0.5_dp*my_alpha, matrix_v, matrix_g, &
1.0_dp, fm_matrix)
CALL cp_fm_gemm("N", "T", nao, nao, ncol, -0.5_dp*my_alpha, matrix_g, matrix_v, &
1.0_dp, fm_matrix)
ELSE
CALL cp_fm_gemm("N", "T", nao, nao, ncol, my_alpha, matrix_v, matrix_g, &
1.0_dp, fm_matrix)
END IF
ELSE
CALL cp_fm_gemm("N", "T", nao, nao, ncol, my_alpha, matrix_v, matrix_v, &
1.0_dp, fm_matrix)
Expand Down
43 changes: 21 additions & 22 deletions src/ec_methods.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,9 @@ MODULE ec_methods
USE cp_blacs_env, ONLY: cp_blacs_env_type
USE cp_control_types, ONLY: dft_control_type
USE cp_dbcsr_operations, ONLY: cp_dbcsr_m_by_n_from_row_template
USE cp_fm_struct, ONLY: cp_fm_struct_create,&
cp_fm_struct_release,&
cp_fm_struct_type
USE cp_fm_types, ONLY: cp_fm_get_info,&
cp_fm_type
USE cp_log_handling, ONLY: cp_to_string
Expand All @@ -34,14 +37,12 @@ MODULE ec_methods
set_qs_env
USE qs_kind_types, ONLY: get_qs_kind_set,&
qs_kind_type
USE qs_matrix_pools, ONLY: mpools_create,&
mpools_rebuild_fm_pools,&
mpools_release,&
USE qs_matrix_pools, ONLY: mpools_release,&
qs_matrix_pools_type
USE qs_mo_types, ONLY: allocate_mo_set,&
get_mo_set,&
init_mo_set,&
mo_set_p_type
mo_set_type
USE qs_rho_types, ONLY: qs_rho_get,&
qs_rho_type
USE xc, ONLY: xc_calc_2nd_deriv,&
Expand Down Expand Up @@ -162,11 +163,12 @@ SUBROUTINE ec_mos_init(qs_env, matrix_s)
INTEGER, DIMENSION(2) :: n_mo, nelectron_spin
REAL(dp) :: maxocc
TYPE(cp_blacs_env_type), POINTER :: blacs_env
TYPE(cp_fm_struct_type), POINTER :: fm_struct
TYPE(cp_fm_type), POINTER :: mo_coeff
TYPE(cp_para_env_type), POINTER :: para_env
TYPE(dbcsr_type), POINTER :: mo_coeff_b
TYPE(dft_control_type), POINTER :: dft_control
TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos
TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
TYPE(qs_matrix_pools_type), POINTER :: my_mpools

Expand Down Expand Up @@ -224,8 +226,7 @@ SUBROUTINE ec_mos_init(qs_env, matrix_s)
! Allocate MO set
ALLOCATE (mos(nspins))
DO ispin = 1, nspins
NULLIFY (mos(ispin)%mo_set)
CALL allocate_mo_set(mo_set=mos(ispin)%mo_set, &
CALL allocate_mo_set(mo_set=mos(ispin), &
nao=n_ao, &
nmo=n_mo(ispin), &
nelectron=nelectron_spin(ispin), &
Expand All @@ -236,29 +237,27 @@ SUBROUTINE ec_mos_init(qs_env, matrix_s)

CALL set_qs_env(qs_env, mos=mos)

! init pools
NULLIFY (my_mpools)
CALL mpools_create(mpools=my_mpools)
CALL mpools_rebuild_fm_pools(mpools=my_mpools, &
mos=mos, &
blacs_env=blacs_env, &
para_env=para_env)

! finish initialization of the MOs
CPASSERT(ASSOCIATED(mos))
NULLIFY (mo_coeff, mo_coeff_b)
DO ispin = 1, SIZE(mos)
CALL get_mo_set(mos(ispin)%mo_set, mo_coeff=mo_coeff, mo_coeff_b=mo_coeff_b)
CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, mo_coeff_b=mo_coeff_b, &
nmo=nmo, nao=n_ao)

IF (.NOT. ASSOCIATED(mo_coeff)) THEN
CALL init_mo_set(mos(ispin)%mo_set, &
fm_pool=my_mpools%ao_mo_fm_pools(ispin)%pool, &
CALL cp_fm_struct_create(fm_struct, nrow_global=n_ao, &
ncol_global=nmo, para_env=para_env, &
context=blacs_env)

CALL init_mo_set(mos(ispin), &
fm_struct=fm_struct, &
name="qs_env%mo"//TRIM(ADJUSTL(cp_to_string(ispin))))
CALL cp_fm_struct_release(fm_struct)
END IF

IF (.NOT. ASSOCIATED(mo_coeff_b)) THEN
CALL cp_fm_get_info(mos(ispin)%mo_set%mo_coeff, ncol_global=nmo)
CALL dbcsr_init_p(mos(ispin)%mo_set%mo_coeff_b)
CALL cp_dbcsr_m_by_n_from_row_template(mos(ispin)%mo_set%mo_coeff_b, &
CALL cp_fm_get_info(mos(ispin)%mo_coeff, ncol_global=nmo)
CALL dbcsr_init_p(mos(ispin)%mo_coeff_b)
CALL cp_dbcsr_m_by_n_from_row_template(mos(ispin)%mo_coeff_b, &
template=matrix_s, &
n=nmo, &
sym=dbcsr_type_no_symmetry)
Expand Down

0 comments on commit 60a779e

Please sign in to comment.