Skip to content

Commit

Permalink
S-ALMO valgrind bug fix (#42)
Browse files Browse the repository at this point in the history 
* S-ALMO valgrind bug fix

* S-ALMO prettified
  • Loading branch information
@RubenStaub @alazzaro
RubenStaub authored and alazzaro committed Oct 11, 2018
1 parent efff131 commit be74c20
Show file tree
Hide file tree
Showing 3 changed files with 34 additions and 16 deletions.
10 changes: 8 additions & 2 deletions src/almo_scf.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -510,7 +510,7 @@ SUBROUTINE almo_scf_initial_guess(qs_env, almo_scf_env)
nspins, unit_nr
INTEGER, DIMENSION(2) :: nelectron_spin
LOGICAL :: aspc_guess, has_unit_metric
REAL(KIND=dp) :: alpha, cs_pos, energy
REAL(KIND=dp) :: alpha, cs_pos, energy, kTS_sum
TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
TYPE(cp_logger_type), POINTER :: logger
TYPE(cp_para_env_type), POINTER :: para_env
Expand Down Expand Up @@ -715,14 +715,20 @@ SUBROUTINE almo_scf_initial_guess(qs_env, almo_scf_env)
END IF
ENDIF
IF (almo_scf_env%smear) THEN
kTS_sum = SUM(almo_scf_env%kTS)
ELSE
kTS_sum = 0.0_dp
ENDIF
CALL almo_dm_to_almo_ks(qs_env, &
almo_scf_env%matrix_p, &
almo_scf_env%matrix_ks, &
energy, &
almo_scf_env%eps_filter, &
almo_scf_env%mat_distr_aos, &
smear=almo_scf_env%smear, &
kTS=almo_scf_env%kTS)
kTS_sum=kTS_sum)
IF (unit_nr > 0) THEN
IF (almo_scf_env%almo_scf_guess .EQ. molecular_guess) THEN
Expand Down
24 changes: 18 additions & 6 deletions src/almo_scf_optimizer.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -126,7 +126,7 @@ SUBROUTINE almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer)
LOGICAL :: converged, prepare_to_exit, should_stop, &
use_diis, use_prev_as_guess
REAL(KIND=dp) :: density_rec, energy_diff, energy_new, energy_old, error_norm, &
error_norm_ispin, prev_error_norm, t1, t2, true_mixing_fraction
error_norm_ispin, kTS_sum, prev_error_norm, t1, t2, true_mixing_fraction
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: local_mu
TYPE(almo_scf_diis_type), ALLOCATABLE, &
DIMENSION(:) :: almo_diis
Expand Down Expand Up @@ -357,6 +357,12 @@ SUBROUTINE almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer)
END IF
ENDIF
IF (almo_scf_env%smear) THEN
kTS_sum = SUM(almo_scf_env%kTS)
ELSE
kTS_sum = 0.0_dp
ENDIF
! compute the new KS matrix and new energy
CALL almo_dm_to_almo_ks(qs_env, &
almo_scf_env%matrix_p, &
Expand All @@ -365,7 +371,7 @@ SUBROUTINE almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer)
almo_scf_env%eps_filter, &
almo_scf_env%mat_distr_aos, &
smear=almo_scf_env%smear, &
kTS=almo_scf_env%kTS)
kTS_sum=kTS_sum)
ENDIF ! prepare_to_exit
Expand Down Expand Up @@ -436,9 +442,8 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer)
INTEGER :: handle, iscf, ispin, nspin, unit_nr
LOGICAL :: converged, prepare_to_exit, should_stop
REAL(KIND=dp) :: denergy_tot, density_rec, energy_diff, &
energy_new, energy_old, error_norm, &
error_norm_0, spin_factor, t1, t2
REAL(KIND=dp) :: denergy_tot, density_rec, energy_diff, energy_new, energy_old, error_norm, &
error_norm_0, kTS_sum, spin_factor, t1, t2
REAL(KIND=dp), DIMENSION(2) :: denergy_spin
TYPE(almo_scf_diis_type), ALLOCATABLE, &
DIMENSION(:) :: almo_diis
Expand Down Expand Up @@ -754,14 +759,21 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer)
! compute the new KS matrix and new energy
IF (.NOT. almo_scf_env%perturbative_delocalization) THEN
IF (almo_scf_env%smear) THEN
kTS_sum = SUM(almo_scf_env%kTS)
ELSE
kTS_sum = 0.0_dp
ENDIF
CALL almo_dm_to_almo_ks(qs_env, &
almo_scf_env%matrix_p, &
almo_scf_env%matrix_ks, &
energy_new, &
almo_scf_env%eps_filter, &
almo_scf_env%mat_distr_aos, &
smear=almo_scf_env%smear, &
kTS=almo_scf_env%kTS)
kTS_sum=kTS_sum)
ENDIF
ENDIF ! prepare_to_exit
Expand Down
16 changes: 8 additions & 8 deletions src/almo_scf_qs.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -771,28 +771,28 @@ END SUBROUTINE almo_dm_to_qs_ks
!> \param eps_filter ...
!> \param mat_distr_aos ...
!> \param smear ...
!> \param kTS ...
!> \param kTS_sum ...
!> \par History
!> 2011.05 created [Rustam Z Khaliullin]
!> 2018.09 smearing support [Ruben Staub]
!> \author Rustam Z Khaliullin
! **************************************************************************************************
SUBROUTINE almo_dm_to_almo_ks(qs_env, matrix_p, matrix_ks, energy_total, eps_filter, &
mat_distr_aos, smear, kTS)
mat_distr_aos, smear, kTS_sum)

TYPE(qs_environment_type), POINTER :: qs_env
TYPE(dbcsr_type), DIMENSION(:) :: matrix_p, matrix_ks
REAL(KIND=dp) :: energy_total, eps_filter
INTEGER, INTENT(IN) :: mat_distr_aos
LOGICAL, INTENT(IN), OPTIONAL :: smear
REAL(KIND=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: kTS
REAL(KIND=dp), INTENT(IN), OPTIONAL :: kTS_sum

CHARACTER(len=*), PARAMETER :: routineN = 'almo_dm_to_almo_ks', &
routineP = moduleN//':'//routineN

INTEGER :: handle, ispin, nspins
LOGICAL :: smearing
REAL(KIND=dp) :: kTS_sum
REAL(KIND=dp) :: entropic_term
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_qs_ks

CALL timeset(routineN, handle)
Expand All @@ -803,16 +803,16 @@ SUBROUTINE almo_dm_to_almo_ks(qs_env, matrix_p, matrix_ks, energy_total, eps_fil
smearing = .FALSE.
ENDIF

IF (PRESENT(kTS) .AND. smearing) THEN
kTS_sum = SUM(kTS)
IF (PRESENT(kTS_sum)) THEN
entropic_term = kTS_sum
ELSE
kTS_sum = 0.0_dp
entropic_term = 0.0_dp
ENDIF

! update KS matrix in the QS env
CALL almo_dm_to_qs_ks(qs_env, matrix_p, energy_total, mat_distr_aos, &
smear=smearing, &
kTS_sum=kTS_sum)
kTS_sum=entropic_term)

nspins = SIZE(matrix_ks)

Expand Down

0 comments on commit be74c20

Please sign in to comment.