Skip to content

Commit

Permalink
New scheme to allow for extended local basis set in GAPW (#2503)
Browse files Browse the repository at this point in the history 
* GAPW Refactoring: soft basis moved to container
get_qs_kind has no longer special access to the basis

* GAPW: Introduce one-center basis set (used to be equ. orb basis).

* GAPW one center basis set generalization
Disentangle projector and basis set information

* Intermediate refactoring of GAPW basis generation and projector setup

* Rebase to master version (pointer changes)

* Node count (comment out for the moment)

* New scheme to allow for extended local basis set in GAPW

* Pretty

* Pretty and license header

* Regtests for ext basis GAPW
  • Loading branch information
@juerghutter
juerghutter committed Jan 16, 2023
1 parent df34d87 commit b673757
Show file tree
Hide file tree
Showing 42 changed files with 1,422 additions and 574 deletions.
28 changes: 14 additions & 14 deletions src/aobasis/basis_set_container_types.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ MODULE basis_set_container_types
lri_aux_basis = 104, &
aux_fit_basis = 105, &
soft_basis = 106, &
hard_basis = 107, &
gapw_1c_basis = 107, &
mao_basis = 108, &
harris_basis = 109, &
aux_gw_basis = 110, &
Expand Down Expand Up @@ -113,10 +113,10 @@ FUNCTION get_basis_type(basis_set_type) RESULT(basis_type_nr)
basis_type_nr = aux_fit_basis
CASE ("AUX_FIT_SOFT")
basis_type_nr = aux_fit_soft_basis
CASE ("SOFT")
CASE ("ORB_SOFT")
basis_type_nr = soft_basis
CASE ("HARD")
basis_type_nr = hard_basis
CASE ("GAPW_1C")
basis_type_nr = gapw_1c_basis
CASE ("MAO")
basis_type_nr = mao_basis
CASE ("HARRIS")
Expand Down Expand Up @@ -199,17 +199,17 @@ SUBROUTINE remove_basis_from_container(container, inum, basis_type)
IF (ASSOCIATED(container(ibas)%basis_set)) THEN
CALL deallocate_gto_basis_set(container(ibas)%basis_set)
END IF
! shift other basis sets
DO i = ibas + 1, SIZE(container)
IF (container(i)%basis_type_nr == 0) CYCLE
container(i - 1)%basis_type = container(i)%basis_type
container(i - 1)%basis_set => container(i)%basis_set
container(i - 1)%basis_type_nr = container(i)%basis_type_nr
container(i)%basis_type = ""
container(i)%basis_type_nr = 0
NULLIFY (container(i)%basis_set)
END DO
END IF
! shift other basis sets
DO i = ibas + 1, SIZE(container)
IF (container(i)%basis_type_nr == 0) CYCLE
container(i - 1)%basis_type = container(i)%basis_type
container(i - 1)%basis_set => container(i)%basis_set
container(i - 1)%basis_type_nr = container(i)%basis_type_nr
container(i)%basis_type = ""
container(i)%basis_type_nr = 0
NULLIFY (container(i)%basis_set)
END DO

END SUBROUTINE remove_basis_from_container

Expand Down
70 changes: 33 additions & 37 deletions src/aobasis/basis_set_types.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -72,18 +72,18 @@ MODULE basis_set_types
!MK PRIVATE
CHARACTER(LEN=default_string_length) :: name
CHARACTER(LEN=default_string_length) :: aliases = ""
REAL(KIND=dp) :: kind_radius
REAL(KIND=dp) :: short_kind_radius
REAL(KIND=dp) :: kind_radius
REAL(KIND=dp) :: short_kind_radius
INTEGER :: norm_type = -1
INTEGER :: ncgf, nset, nsgf
CHARACTER(LEN=12), DIMENSION(:), POINTER :: cgf_symbol
CHARACTER(LEN=6), DIMENSION(:), POINTER :: sgf_symbol
REAL(KIND=dp), DIMENSION(:), POINTER :: norm_cgf, set_radius
REAL(KIND=dp), DIMENSION(:), POINTER :: norm_cgf, set_radius
INTEGER, DIMENSION(:), POINTER :: lmax, lmin, lx, ly, lz, m, ncgf_set, &
npgf, nsgf_set, nshell
REAL(KIND=dp), DIMENSION(:, :), POINTER :: cphi, pgf_radius, sphi, scon, zet
INTEGER, DIMENSION(:, :), POINTER :: first_cgf, first_sgf, l, &
last_cgf, last_sgf, n
REAL(KIND=dp), DIMENSION(:, :), POINTER :: cphi, pgf_radius, sphi, scon, zet
INTEGER, DIMENSION(:, :), POINTER :: first_cgf, first_sgf, l, &
last_cgf, last_sgf, n
REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: gcc
END TYPE gto_basis_set_type

Expand All @@ -100,7 +100,7 @@ MODULE basis_set_types
INTEGER :: nshell
CHARACTER(LEN=6), DIMENSION(:), POINTER :: symbol
INTEGER, DIMENSION(:), POINTER :: nq, lq
REAL(KIND=dp), DIMENSION(:), POINTER :: zet
REAL(KIND=dp), DIMENSION(:), POINTER :: zet
END TYPE sto_basis_set_type

! **************************************************************************************************
Expand Down Expand Up @@ -198,36 +198,32 @@ SUBROUTINE deallocate_gto_basis_set(gto_basis_set)
TYPE(gto_basis_set_type), POINTER :: gto_basis_set

IF (ASSOCIATED(gto_basis_set)) THEN
IF (ASSOCIATED(gto_basis_set%cgf_symbol)) THEN
DEALLOCATE (gto_basis_set%cgf_symbol)
END IF
IF (ASSOCIATED(gto_basis_set%sgf_symbol)) THEN
DEALLOCATE (gto_basis_set%sgf_symbol)
END IF
DEALLOCATE (gto_basis_set%norm_cgf)
DEALLOCATE (gto_basis_set%set_radius)
DEALLOCATE (gto_basis_set%lmax)
DEALLOCATE (gto_basis_set%lmin)
DEALLOCATE (gto_basis_set%lx)
DEALLOCATE (gto_basis_set%ly)
DEALLOCATE (gto_basis_set%lz)
DEALLOCATE (gto_basis_set%m)
DEALLOCATE (gto_basis_set%ncgf_set)
DEALLOCATE (gto_basis_set%npgf)
DEALLOCATE (gto_basis_set%nsgf_set)
DEALLOCATE (gto_basis_set%nshell)
DEALLOCATE (gto_basis_set%cphi)
DEALLOCATE (gto_basis_set%pgf_radius)
DEALLOCATE (gto_basis_set%sphi)
DEALLOCATE (gto_basis_set%scon)
DEALLOCATE (gto_basis_set%zet)
DEALLOCATE (gto_basis_set%first_cgf)
DEALLOCATE (gto_basis_set%first_sgf)
DEALLOCATE (gto_basis_set%l)
DEALLOCATE (gto_basis_set%last_cgf)
DEALLOCATE (gto_basis_set%last_sgf)
DEALLOCATE (gto_basis_set%n)
DEALLOCATE (gto_basis_set%gcc)
IF (ASSOCIATED(gto_basis_set%cgf_symbol)) DEALLOCATE (gto_basis_set%cgf_symbol)
IF (ASSOCIATED(gto_basis_set%sgf_symbol)) DEALLOCATE (gto_basis_set%sgf_symbol)
IF (ASSOCIATED(gto_basis_set%norm_cgf)) DEALLOCATE (gto_basis_set%norm_cgf)
IF (ASSOCIATED(gto_basis_set%set_radius)) DEALLOCATE (gto_basis_set%set_radius)
IF (ASSOCIATED(gto_basis_set%lmax)) DEALLOCATE (gto_basis_set%lmax)
IF (ASSOCIATED(gto_basis_set%lmin)) DEALLOCATE (gto_basis_set%lmin)
IF (ASSOCIATED(gto_basis_set%lx)) DEALLOCATE (gto_basis_set%lx)
IF (ASSOCIATED(gto_basis_set%ly)) DEALLOCATE (gto_basis_set%ly)
IF (ASSOCIATED(gto_basis_set%lz)) DEALLOCATE (gto_basis_set%lz)
IF (ASSOCIATED(gto_basis_set%m)) DEALLOCATE (gto_basis_set%m)
IF (ASSOCIATED(gto_basis_set%ncgf_set)) DEALLOCATE (gto_basis_set%ncgf_set)
IF (ASSOCIATED(gto_basis_set%npgf)) DEALLOCATE (gto_basis_set%npgf)
IF (ASSOCIATED(gto_basis_set%nsgf_set)) DEALLOCATE (gto_basis_set%nsgf_set)
IF (ASSOCIATED(gto_basis_set%nshell)) DEALLOCATE (gto_basis_set%nshell)
IF (ASSOCIATED(gto_basis_set%cphi)) DEALLOCATE (gto_basis_set%cphi)
IF (ASSOCIATED(gto_basis_set%pgf_radius)) DEALLOCATE (gto_basis_set%pgf_radius)
IF (ASSOCIATED(gto_basis_set%sphi)) DEALLOCATE (gto_basis_set%sphi)
IF (ASSOCIATED(gto_basis_set%scon)) DEALLOCATE (gto_basis_set%scon)
IF (ASSOCIATED(gto_basis_set%zet)) DEALLOCATE (gto_basis_set%zet)
IF (ASSOCIATED(gto_basis_set%first_cgf)) DEALLOCATE (gto_basis_set%first_cgf)
IF (ASSOCIATED(gto_basis_set%first_sgf)) DEALLOCATE (gto_basis_set%first_sgf)
IF (ASSOCIATED(gto_basis_set%l)) DEALLOCATE (gto_basis_set%l)
IF (ASSOCIATED(gto_basis_set%last_cgf)) DEALLOCATE (gto_basis_set%last_cgf)
IF (ASSOCIATED(gto_basis_set%last_sgf)) DEALLOCATE (gto_basis_set%last_sgf)
IF (ASSOCIATED(gto_basis_set%n)) DEALLOCATE (gto_basis_set%n)
IF (ASSOCIATED(gto_basis_set%gcc)) DEALLOCATE (gto_basis_set%gcc)
DEALLOCATE (gto_basis_set)
END IF
END SUBROUTINE deallocate_gto_basis_set
Expand Down
92 changes: 92 additions & 0 deletions src/aobasis/paw_basis_types.F
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,92 @@
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2023 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!

! **************************************************************************************************
!> \par History
!> none
!> \author JGH (9.2022)
! **************************************************************************************************
MODULE paw_basis_types

USE basis_set_types, ONLY: get_gto_basis_set,&
gto_basis_set_type
USE orbital_pointers, ONLY: nso,&
nsoset
#include "../base/base_uses.f90"

IMPLICIT NONE

PRIVATE

CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'paw_basis_types'

PUBLIC :: get_paw_basis_info

CONTAINS

! **************************************************************************************************
!> \brief Return some info on the PAW basis derived from a GTO basis set
!> \param basis_1c The parent GTO basis set
!> \param o2nindex ...
!> \param n2oindex ...
!> \param nsatbas ...
!> \version 1.0
! **************************************************************************************************
SUBROUTINE get_paw_basis_info(basis_1c, o2nindex, n2oindex, nsatbas)

TYPE(gto_basis_set_type), POINTER :: basis_1c
INTEGER, DIMENSION(:), OPTIONAL, POINTER :: o2nindex, n2oindex
INTEGER, INTENT(OUT), OPTIONAL :: nsatbas

INTEGER :: ico, ipgf, iset, iso, iso_pgf, iso_set, &
k, lx, maxso, nset, nsox
INTEGER, DIMENSION(:), POINTER :: lmax, lmin, npgf
LOGICAL :: n2o, nsa, o2n

CPASSERT(ASSOCIATED(basis_1c))

o2n = PRESENT(o2nindex)
n2o = PRESENT(n2oindex)
nsa = PRESENT(nsatbas)

IF (o2n .OR. n2o .OR. nsa) THEN
CALL get_gto_basis_set(gto_basis_set=basis_1c, &
nset=nset, lmax=lmax, lmin=lmin, npgf=npgf, maxso=maxso)

! Index transformation OLD-NEW
IF (o2n) THEN
ALLOCATE (o2nindex(maxso*nset))
o2nindex = 0
END IF
IF (n2o) THEN
ALLOCATE (n2oindex(maxso*nset))
n2oindex = 0
END IF

ico = 1
DO iset = 1, nset
iso_set = (iset - 1)*maxso + 1
nsox = nsoset(lmax(iset))
DO ipgf = 1, npgf(iset)
iso_pgf = iso_set + (ipgf - 1)*nsox
iso = iso_pgf + nsoset(lmin(iset) - 1)
DO lx = lmin(iset), lmax(iset)
DO k = 1, nso(lx)
IF (n2o) n2oindex(ico) = iso
IF (o2n) o2nindex(iso) = ico
iso = iso + 1
ico = ico + 1
END DO
END DO
END DO
END DO
IF (nsa) nsatbas = ico - 1
END IF

END SUBROUTINE get_paw_basis_info

END MODULE paw_basis_types
10 changes: 7 additions & 3 deletions src/aobasis/soft_basis_set.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,9 @@
MODULE soft_basis_set

USE ao_util, ONLY: exp_radius
USE basis_set_types, ONLY: get_gto_basis_set,&
USE basis_set_types, ONLY: copy_gto_basis_set,&
deallocate_gto_basis_set,&
get_gto_basis_set,&
gto_basis_set_type,&
init_cphi_and_sphi
USE kinds, ONLY: default_string_length,&
Expand Down Expand Up @@ -297,8 +299,10 @@ SUBROUTINE create_soft_basis(orb_basis, soft_basis, eps_fit, rc, paw_atom, &
END IF

IF (.NOT. paw_atom) THEN
DEALLOCATE (soft_basis)
soft_basis => orb_basis
CALL deallocate_gto_basis_set(soft_basis)
CALL copy_gto_basis_set(orb_basis, soft_basis)
CALL get_gto_basis_set(gto_basis_set=orb_basis, name=bsname)
soft_basis%name = TRIM(bsname)//"_soft"
END IF

END SUBROUTINE create_soft_basis
Expand Down
5 changes: 5 additions & 0 deletions src/atom_fit.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1541,6 +1541,11 @@ SUBROUTINE pseudo_fit(atom_info, wfn_guess, ppot, afun, wtot, pval, dener, wen,
CALL atom_orbital_nodes(node, atom%orbitals%wfn(:, k, l), 2._dp*rcov, l, atom%basis)
afun = afun + atom%weight*atom%orbitals%wrefnod(k, l, 1)* &
ABS(REAL(node, dp) - atom%orbitals%refnod(k, l, 1))
!deb
! IF (ABS(REAL(node, dp) - atom%orbitals%refnod(k, l, 1)) > 1.e-5_dp) THEN
! WRITE (6, *) "NODES ", k, l, node, atom%orbitals%refnod(k, l, 1)
! END IF
!deb
END IF
IF (l == 0) THEN
IF (atom%orbitals%wpsir0(k, 1) > 0._dp) THEN
Expand Down
1 change: 1 addition & 0 deletions src/cp_control_types.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -170,6 +170,7 @@ MODULE cp_control_types
! \brief Control parameters for GAPW method within QUICKSTEP ***
! **************************************************************************************************
TYPE gapw_control_type
INTEGER :: basis_1c
REAL(KIND=dp) :: eps_fit, &
eps_iso, &
eps_Vrho0, &
Expand Down
46 changes: 45 additions & 1 deletion src/cp_control_utils.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,8 @@ MODULE cp_control_utils
do_method_pnnl, do_method_rigpw, do_method_rm1, do_method_xtb, do_pwgrid_ns_fullspace, &
do_pwgrid_ns_halfspace, do_pwgrid_spherical, do_s2_constraint, do_s2_restraint, &
do_se_is_kdso, do_se_is_kdso_d, do_se_is_slater, do_se_lr_ewald, do_se_lr_ewald_gks, &
do_se_lr_ewald_r3, do_se_lr_none, gaussian_env, numerical, ramp_env, &
do_se_lr_ewald_r3, do_se_lr_none, gapw_1c_large, gapw_1c_medium, gapw_1c_orb, &
gapw_1c_small, gapw_1c_very_large, gaussian_env, numerical, ramp_env, &
real_time_propagation, sccs_andreussi, sccs_derivative_cd3, sccs_derivative_cd5, &
sccs_derivative_cd7, sccs_derivative_fft, sccs_fattebert_gygi, sic_ad, sic_eo, &
sic_list_all, sic_list_unpaired, sic_mauri_spz, sic_mauri_us, sic_none, slater, &
Expand Down Expand Up @@ -769,6 +770,11 @@ SUBROUTINE read_qs_section(qs_control, qs_section)
CALL section_vals_val_get(qs_section, "LMAXN0", i_val=qs_control%gapw_control%lmax_rho0)
CALL section_vals_val_get(qs_section, "LADDN0", i_val=qs_control%gapw_control%ladd_rho0)
CALL section_vals_val_get(qs_section, "QUADRATURE", i_val=qs_control%gapw_control%quadrature)
! GAPW 1c basis
CALL section_vals_val_get(qs_section, "GAPW_1C_BASIS", i_val=qs_control%gapw_control%basis_1c)
IF (qs_control%gapw_control%basis_1c /= gapw_1c_orb) THEN
qs_control%gapw_control%eps_svd = MAX(qs_control%gapw_control%eps_svd, 1.E-12_dp)
END IF
! Integers grids
CALL section_vals_val_get(qs_section, "PW_GRID", i_val=itmp)
Expand Down Expand Up @@ -1872,6 +1878,25 @@ SUBROUTINE write_qs_control(qs_control, dft_section)
"QS| eps_ppnl:", &
qs_control%eps_ppnl
IF (qs_control%gapw) THEN
SELECT CASE (qs_control%gapw_control%basis_1c)
CASE (gapw_1c_orb)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW| One center basis from orbital basis primitives"
CASE (gapw_1c_small)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW| One center basis extended with primitives (small:s)"
CASE (gapw_1c_medium)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW| One center basis extended with primitives (medium:sp)"
CASE (gapw_1c_large)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW| One center basis extended with primitives (large:spd)"
CASE (gapw_1c_very_large)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW| One center basis extended with primitives (very large:spdf)"
CASE DEFAULT
CPABORT("basis_1c incorrect")
END SELECT
WRITE (UNIT=output_unit, FMT="(T2,A,T73,ES8.1)") &
"QS| GAPW| eps_fit:", &
qs_control%gapw_control%eps_fit, &
Expand Down Expand Up @@ -1899,6 +1924,25 @@ SUBROUTINE write_qs_control(qs_control, dft_section)
END IF
END IF
IF (qs_control%gapw_xc) THEN
SELECT CASE (qs_control%gapw_control%basis_1c)
CASE (gapw_1c_orb)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW_XC| One center basis from orbital basis primitives"
CASE (gapw_1c_small)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW_XC| One center basis extended with primitives (small:s)"
CASE (gapw_1c_medium)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW_XC| One center basis extended with primitives (medium:sp)"
CASE (gapw_1c_large)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW_XC| One center basis extended with primitives (large:spd)"
CASE (gapw_1c_very_large)
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"QS| GAPW_XC| One center basis extended with primitives (very large:spdf)"
CASE DEFAULT
CPABORT("basis_1c incorrect")
END SELECT
WRITE (UNIT=output_unit, FMT="(T2,A,T73,ES8.1)") &
"QS| GAPW_XC| eps_fit:", &
qs_control%gapw_control%eps_fit, &
Expand Down

0 comments on commit b673757

Please sign in to comment.