Skip to content

Commit

Permalink
Fix in dcdr: Remove STAT= and print statement; replace calls to cp_fm…
Browse files Browse the repository at this point in the history 
…_gemm by cp_gemm; nullify DBCSR matrix
  • Loading branch information
@edditler @mkrack
edditler authored and mkrack committed Nov 18, 2021
1 parent d5199b2 commit 0598928
Show file tree
Hide file tree
Showing 4 changed files with 22 additions and 23 deletions.
4 changes: 2 additions & 2 deletions src/aobasis/ai_moments.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ SUBROUTINE diff_momop2(la_max, npgfa, zeta, rpgfa, la_min, &
OPTIONAL, POINTER :: deltaR
INTEGER, INTENT(IN), OPTIONAL :: iatom, jatom

INTEGER :: imom, istat, lda, lda_min, ldb, ldb_min
INTEGER :: imom, lda, lda_min, ldb, ldb_min
REAL(KIND=dp) :: dab, rab(3)
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: difmab_tmp
REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: mab
Expand All @@ -115,7 +115,7 @@ SUBROUTINE diff_momop2(la_max, npgfa, zeta, rpgfa, la_min, &
mab => mab_ext
ELSE
ALLOCATE (mab(npgfa*ncoset(la_max + 1), npgfb*ncoset(lb_max + 1), &
ncoset(order) - 1), STAT=istat)
ncoset(order) - 1))
mab = 0.0_dp
! *** Calculate the primitive moment integrals ***
CALL moment(la_max + 1, npgfa, zeta, rpgfa, lda_min, &
Expand Down
1 change: 0 additions & 1 deletion src/qs_collocate_density.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1041,7 +1041,6 @@ SUBROUTINE calculate_drho_core(drho_core, qs_env, beta, lambda)
CASE (3)
dabqadb_func = GRID_FUNC_CORE_Z
CASE DEFAULT
PRINT *, 'beta', beta
CPABORT("invalid beta")
END SELECT
DO ikind = 1, SIZE(atomic_kind_set)
Expand Down
39 changes: 19 additions & 20 deletions src/qs_dcdr.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,7 @@ MODULE qs_dcdr
USE cp_dbcsr_operations, ONLY: cp_dbcsr_sm_fm_multiply,&
dbcsr_allocate_matrix_set,&
dbcsr_deallocate_matrix_set
USE cp_fm_basic_linalg, ONLY: cp_fm_gemm,&
cp_fm_scale,&
USE cp_fm_basic_linalg, ONLY: cp_fm_scale,&
cp_fm_scale_and_add,&
cp_fm_trace
USE cp_fm_types, ONLY: cp_fm_create,&
Expand Down Expand Up @@ -388,16 +387,16 @@ SUBROUTINE apt_dR(qs_env, dcdr_env)
CALL cp_fm_scale_and_add(0._dp, dcdr_env%dCR_prime(1)%matrix, 1._dp, dcdr_env%dCR(1)%matrix)
CALL cp_dbcsr_sm_fm_multiply(dcdr_env%matrix_s1(dcdr_env%beta + 1)%matrix, mo_coeff, &
tmp_fm_like_mos%matrix, ncol=nmo)
CALL cp_fm_gemm("T", "N", nmo, nmo, nao, &
1.0_dp, mo_coeff, tmp_fm_like_mos%matrix, &
0.0_dp, overlap1_MO%matrix)
CALL cp_gemm("T", "N", nmo, nmo, nao, &
1.0_dp, mo_coeff, tmp_fm_like_mos%matrix, &
0.0_dp, overlap1_MO%matrix)
! C^1 <- -dCR - 0.5 * mo_coeff @ S1_ij
! We get the negative of the coefficients out of the linres solver
! And apply the constant correction due to the overlap derivative.
CALL cp_fm_gemm("N", "N", nao, nmo, nmo, &
-0.5_dp, mo_coeff, overlap1_MO%matrix, &
-1.0_dp, dcdr_env%dCR_prime(1)%matrix)
CALL cp_gemm("N", "N", nao, nmo, nmo, &
-0.5_dp, mo_coeff, overlap1_MO%matrix, &
-1.0_dp, dcdr_env%dCR_prime(1)%matrix)
DO alpha = 1, 3
! FIRST CONTRIBUTION: dCR * moments * mo
Expand Down Expand Up @@ -554,14 +553,14 @@ SUBROUTINE apt_dR_localization(qs_env, dcdr_env)
CALL cp_fm_scale_and_add(0._dp, dcdr_env%dCR_prime(1)%matrix, 1._dp, dcdr_env%dCR(1)%matrix)
CALL cp_dbcsr_sm_fm_multiply(dcdr_env%matrix_s1(dcdr_env%beta + 1)%matrix, mo_coeff, &
tmp_fm%matrix, ncol=nmo)
CALL cp_fm_gemm("T", "N", nmo, nmo, nao, &
1.0_dp, mo_coeff, tmp_fm%matrix, &
0.0_dp, tmp_fm_momo(1)%matrix)
CALL cp_gemm("T", "N", nmo, nmo, nao, &
1.0_dp, mo_coeff, tmp_fm%matrix, &
0.0_dp, tmp_fm_momo(1)%matrix)
! C^1 <- -dCR - 0.5 * mo_coeff @ S1_ij
CALL cp_fm_gemm("N", "N", nao, nmo, nmo, &
-0.5_dp, mo_coeff, tmp_fm_momo(1)%matrix, &
-1.0_dp, dcdr_env%dCR_prime(1)%matrix)
CALL cp_gemm("N", "N", nao, nmo, nmo, &
-0.5_dp, mo_coeff, tmp_fm_momo(1)%matrix, &
-1.0_dp, dcdr_env%dCR_prime(1)%matrix)
! FIRST CONTRIBUTION: dCR * moments * mo
this_factor = -2._dp*f_spin
Expand All @@ -576,9 +575,9 @@ SUBROUTINE apt_dR_localization(qs_env, dcdr_env)
CALL dbcsr_set(dcdr_env%moments(alpha)%matrix, 0.0_dp)
END DO
CALL cp_fm_gemm("T", "N", nmo, nmo, nao, &
1.0_dp, mo_coeff, tmp_fm_like_mos(alpha)%matrix, &
0.0_dp, tmp_fm_momo(alpha)%matrix)
CALL cp_gemm("T", "N", nmo, nmo, nao, &
1.0_dp, mo_coeff, tmp_fm_like_mos(alpha)%matrix, &
0.0_dp, tmp_fm_momo(alpha)%matrix)
CALL cp_fm_get_diag(tmp_fm_momo(alpha)%matrix, diagonal_elements)
DO icenter = 1, dcdr_env%nbr_center(1)
Expand Down Expand Up @@ -617,9 +616,9 @@ SUBROUTINE apt_dR_localization(qs_env, dcdr_env)
res=tmp_fm_like_mos(alpha)%matrix)
END DO ! icenter
CALL cp_fm_gemm("T", "N", nmo, nmo, nao, &
1.0_dp, mo_coeff, tmp_fm_like_mos(alpha)%matrix, &
0.0_dp, tmp_fm_momo(alpha)%matrix)
CALL cp_gemm("T", "N", nmo, nmo, nao, &
1.0_dp, mo_coeff, tmp_fm_like_mos(alpha)%matrix, &
0.0_dp, tmp_fm_momo(alpha)%matrix)
CALL cp_fm_get_diag(tmp_fm_momo(alpha)%matrix, diagonal_elements)
DO icenter = 1, dcdr_env%nbr_center(1)
Expand Down
1 change: 1 addition & 0 deletions src/qs_dcdr_utils.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -890,6 +890,7 @@ SUBROUTINE dcdr_env_init(dcdr_env, qs_env)
CALL dbcsr_allocate_matrix_set(dcdr_env%matrix_hc, 3)
CALL dbcsr_allocate_matrix_set(dcdr_env%matrix_ppnl_1, 3)

NULLIFY (dcdr_env%perturbed_dm_correction)
CALL dbcsr_init_p(dcdr_env%perturbed_dm_correction)
CALL dbcsr_copy(dcdr_env%perturbed_dm_correction, matrix_ks(1)%matrix)

Expand Down

0 comments on commit 0598928

Please sign in to comment.