Skip to content

Commit

Permalink
Further refactoring and bug fixes, regtests
Browse files Browse the repository at this point in the history
  • Loading branch information
juerghutter committed Mar 19, 2019
1 parent b0b4954 commit 99c43e5
Show file tree
Hide file tree
Showing 21 changed files with 1,053 additions and 574 deletions.
2 changes: 2 additions & 0 deletions src/cp_control_types.F
Original file line number Diff line number Diff line change
Expand Up @@ -111,6 +111,8 @@ MODULE cp_control_types
REAL(KIND=dp) :: kxr, kx2
!
LOGICAL :: xb_interaction
LOGICAL :: coulomb_interaction
LOGICAL :: tb3_interaction
REAL(KIND=dp) :: xb_radius
!
CHARACTER(LEN=default_string_length), &
Expand Down
5 changes: 5 additions & 0 deletions src/cp_control_utils.F
Original file line number Diff line number Diff line change
Expand Up @@ -1091,6 +1091,11 @@ SUBROUTINE read_qs_section(qs_control, qs_section)
CALL section_vals_val_get(xtb_parameter, "XB_RADIUS", r_val=qs_control%xtb_control%xb_radius)
! Kab
CALL section_vals_val_get(xtb_parameter, "KAB_PARAM", n_rep_val=n_rep)
! For debug purposes
CALL section_vals_val_get(xtb_section, "COULOMB_INTERACTION", &
l_val=qs_control%xtb_control%coulomb_interaction)
CALL section_vals_val_get(xtb_section, "TB3_INTERACTION", &
l_val=qs_control%xtb_control%tb3_interaction)
IF (n_rep > 0) THEN
ALLOCATE (qs_control%xtb_control%kab_param(3, n_rep))
DO j = 1, n_rep
Expand Down
14 changes: 13 additions & 1 deletion src/input_cp2k_tb.F
Original file line number Diff line number Diff line change
Expand Up @@ -167,7 +167,19 @@ SUBROUTINE create_xtb_control_section(section)

CALL keyword_create(keyword, name="USE_HALOGEN_CORRECTION", &
description="Use XB interaction term", &
usage="USE_HALOGEN_CORRECTION", default_l_val=.TRUE.)
usage="USE_HALOGEN_CORRECTION T", default_l_val=.TRUE., lone_keyword_l_val=.TRUE.)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)

CALL keyword_create(keyword, name="COULOMB_INTERACTION", &
description="Use Coulomb interaction terms (electrostatics + TB3); for debug only", &
usage="COULOMB_INTERACTION T", default_l_val=.TRUE., lone_keyword_l_val=.TRUE.)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)

CALL keyword_create(keyword, name="TB3_INTERACTION", &
description="Use TB3 interaction terms; for debug only", &
usage="TB3_INTERACTION T", default_l_val=.TRUE., lone_keyword_l_val=.TRUE.)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)

Expand Down
71 changes: 28 additions & 43 deletions src/qs_dftb3_methods.F
Original file line number Diff line number Diff line change
Expand Up @@ -28,14 +28,11 @@ MODULE qs_dftb3_methods
kpoint_type
USE message_passing, ONLY: mp_sum
USE particle_types, ONLY: particle_type
USE qs_dftb_types, ONLY: qs_dftb_atom_type
USE qs_dftb_utils, ONLY: get_dftb_atom_param
USE qs_energy_types, ONLY: qs_energy_type
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
USE qs_force_types, ONLY: qs_force_type
USE qs_kind_types, ONLY: get_qs_kind,&
qs_kind_type
USE qs_kind_types, ONLY: qs_kind_type
USE qs_neighbor_list_types, ONLY: get_iterator_info,&
neighbor_list_iterate,&
neighbor_list_iterator_create,&
Expand Down Expand Up @@ -167,11 +164,11 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma,
CALL dbcsr_iterator_start(iter, matrix_s(1, 1)%matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, irow, icol, sblock, blk)
ikind = kind_of(iatom)
atom_i = atom_of_kind(iatom)
ikind = kind_of(irow)
atom_i = atom_of_kind(irow)
ui = xgamma(ikind)
jkind = kind_of(jatom)
atom_j = atom_of_kind(jatom)
jkind = kind_of(icol)
atom_j = atom_of_kind(icol)
uj = xgamma(jkind)
!
gmij = -0.5_dp*(ui*mcharge(irow)**2+uj*mcharge(icol)**2)
Expand Down Expand Up @@ -219,23 +216,18 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma,
ic = cell_to_index(cellind(1), cellind(2), cellind(3))
CPASSERT(ic > 0)

ikind = kind_of(iatom)
atom_i = atom_of_kind(iatom)
ui = xgamma(ikind)
jkind = kind_of(jatom)
atom_j = atom_of_kind(jatom)
uj = xgamma(jkind)
!
gmij = -0.5_dp*(ui*mcharge(iatom)**2+uj*mcharge(jatom)**2)
!
NULLIFY (pblock)
CALL dbcsr_get_block_p(matrix=matrix_p(1, ic)%matrix, &
row=irow, col=icol, block=pblock, found=found)
CPASSERT(found)
DO i = 1, 3
NULLIFY (dsblock)
CALL dbcsr_get_block_p(matrix=matrix_s(1+i, ic)%matrix, &
row=irow, col=icol, block=dsblock, found=found)
ikind = kind_of(iatom)
atom_i = atom_of_kind(iatom)
ui = xgamma(ikind)
jkind = kind_of(jatom)
atom_j = atom_of_kind(jatom)
uj = xgamma(jkind)
!
gmij = -0.5_dp*(ui*mcharge(iatom)**2+uj*mcharge(jatom)**2)
!
NULLIFY (pblock)
CALL dbcsr_get_block_p(matrix=matrix_p(1, ic)%matrix, &
row=irow, col=icol, block=pblock, found=found)
CPASSERT(found)
DO i = 1, 3
NULLIFY (dsblock)
Expand Down Expand Up @@ -293,11 +285,9 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma,
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, irow, icol, sblock, blk)
ikind = kind_of(irow)
CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_kind)
CALL get_dftb_atom_param(dftb_kind, dudq=ui)
ui = xgamma(ikind)
jkind = kind_of(icol)
CALL get_qs_kind(qs_kind_set(jkind), dftb_parameter=dftb_kind)
CALL get_dftb_atom_param(dftb_kind, dudq=uj)
uj = xgamma(jkind)
gmij = -0.5_dp*(ui*mcharge(irow)**2+uj*mcharge(icol)**2)
DO is = 1, SIZE(ks_matrix, 1)
NULLIFY (ksblock)
Expand All @@ -322,20 +312,15 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma,
ic = cell_to_index(cellind(1), cellind(2), cellind(3))
CPASSERT(ic > 0)

ikind = kind_of(iatom)
ui = xgamma(ikind)
jkind = kind_of(jatom)
uj = xgamma(jkind)
gmij = -0.5_dp*(ui*mcharge(iatom)**2+uj*mcharge(jatom)**2)
!
NULLIFY (sblock)
CALL dbcsr_get_block_p(matrix=matrix_s(1, ic)%matrix, &
row=irow, col=icol, block=sblock, found=found)
CPASSERT(found)
DO is = 1, SIZE(ks_matrix, 1)
NULLIFY (ksblock)
CALL dbcsr_get_block_p(matrix=ks_matrix(is, ic)%matrix, &
row=irow, col=icol, block=ksblock, found=found)
ikind = kind_of(iatom)
ui = xgamma(ikind)
jkind = kind_of(jatom)
uj = xgamma(jkind)
gmij = -0.5_dp*(ui*mcharge(iatom)**2+uj*mcharge(jatom)**2)
!
NULLIFY (sblock)
CALL dbcsr_get_block_p(matrix=matrix_s(1, ic)%matrix, &
row=irow, col=icol, block=sblock, found=found)
CPASSERT(found)
DO is = 1, SIZE(ks_matrix, 1)
NULLIFY (ksblock)
Expand Down
20 changes: 5 additions & 15 deletions src/qs_dftb_coulomb.F
Original file line number Diff line number Diff line change
Expand Up @@ -104,29 +104,17 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, &
CHARACTER(len=*), PARAMETER :: routineN = 'build_dftb_coulomb', &
routineP = moduleN//':'//routineN

<<<<<<< HEAD
INTEGER :: atom_i, atom_j, blk, ewald_type, handle, i, ia, iatom, ic, icol, ikind, img, &
irow, is, jatom, jkind, natom, natorb_a, natorb_b, nimg, nmat
irow, is, jatom, jkind, natom, natorb_a, natorb_b, nimg, nkind, nmat
INTEGER, DIMENSION(3) :: cellind, periodic
INTEGER, DIMENSION(:), POINTER :: atom_of_kind, kind_of
INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
LOGICAL :: defined, do_ewald, found, hb_sr_damp, &
use_virial
REAL(KIND=dp) :: alpha, ddr, deth, dgam, dr, drm, drp, &
fi, ga, gb, gmat, gmij, hb_para, zeff
REAL(KIND=dp), DIMENSION(0:3) :: eta_a, eta_b
=======
INTEGER :: atom_i, atom_j, blk, ewald_type, handle, &
i, ia, iatom, ic, icol, ikind, img, &
irow, is, jatom, jkind, natom, nimg, &
nkind, nmat
INTEGER, DIMENSION(3) :: cellind, periodic
INTEGER, DIMENSION(:), POINTER :: atom_of_kind, kind_of
INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
LOGICAL :: do_ewald, found, use_virial
REAL(KIND=dp) :: alpha, deth, dr, fi, gmij, zeff
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: xgamma, zeffk
>>>>>>> xTB coulomb energies
REAL(KIND=dp), DIMENSION(0:3) :: eta_a, eta_b
REAL(KIND=dp), DIMENSION(3) :: fij, rij
REAL(KIND=dp), DIMENSION(:, :), POINTER :: dsblock, gmcharge, ksblock, pblock, &
sblock
Expand Down Expand Up @@ -315,10 +303,12 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, &
CALL get_qs_env(qs_env=qs_env, &
local_particles=local_particles)
DO ikind = 1, SIZE(local_particles%n_el)
CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_kind)
CALL get_dftb_atom_param(dftb_kind, zeff=zeff)
DO ia = 1, local_particles%n_el(ikind)
iatom = local_particles%list(ikind)%array(ia)
atprop%atecoul(iatom) = atprop%atecoul(iatom)+ &
0.5_dp*mcharge(iatom)*gmcharge(iatom, 1)
0.5_dp*zeff*gmcharge(iatom, 1)
END DO
END DO
END IF
Expand Down

0 comments on commit 99c43e5

Please sign in to comment.