comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-28 14:15:19 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

TDDFT Forces (beta version) (#1670)

Browse source 
* Excited state forces: input and flow logic

Collect all density matrix type routines into qs_density_matrices

TDDFPT with kernel = NONE

* TDA dipole moments

Kernel forces LSD

Triplet case (forces)

* Further work on TDDFPT forces (ADMM part)

* Hybrid functinal TDDFPT forces with regtests

* HFX/ADMM (ground state) TDDFT forces + regtests

HFX/ADMM kernel forces (w/o correction term) + regtests

* ADMM X correction TDA forces + regtests

* Towards xTB/sTDA forces + regtests

* TB excited state dipoles

* xTB/sTDA excited state dipoles + regtests

* xTB/sTDA Ewald forces + regtests

* HFX/ADMM functional simplifications, many new regtests

* Hybrid functionals polarizability tests activated

* Resolve merge conflicts
Reduce regtest times

* Merge codes Harris forces and TDDFT forces
This commit is contained in:
Juerg Hutter 2021-10-11 18:13:50 +02:00 • committed by GitHub
parent 15378df3ae
commit a938171505
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
303 changed files with 24133 additions and 1566 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/common/bibliography.F
View file

@ -1982,8 +1982,8 @@ CONTAINS
CALL add_reference(key=Kolafa2004, ISI_record=s2a( &
"AU Kolafa, J", &
"TI Time-reversible always stable predictor-corrector method for "// &
"molecular dynamics of polarizable molecules", &
"TI Time-reversible always stable predictor-corrector method for ", &
" molecular dynamics of polarizable molecules", &
"SO JOURNAL OF COMPUTATIONAL CHEMISTRY", &
"SN 0192-8651", &
"J9 J COMPUT CHEM", &

15
src/cp2k_debug.F
View file

@ -407,14 +407,27 @@ CONTAINS
WRITE (UNIT=iw, FMT="(T13,A1,T21,F16.8,T38,F16.8,T56,G12.3,T72,F9.3)") &
ACHAR(119 + k), dipole_numer(k), dipole_moment(k), dd, derr
ELSE
derr = 0.0_dp
WRITE (UNIT=iw, FMT="(T13,A1,T21,F16.8,T38,F16.8,T56,G12.3)") &
ACHAR(119 + k), dipole_numer(k), dipole_moment(k), dd
END IF
err(k) = derr
END DO
WRITE (UNIT=iw, FMT="((T2,A))") &
"DEBUG|========================================================================="
WRITE (UNIT=iw, FMT="(T2,A,T61,E20.12)") ' DIPOLE : CheckSum =', SUM(dipole_moment)
WRITE (UNIT=iw, FMT="(T2,A,T61,E20.12)") 'DIPOLE : CheckSum =', SUM(dipole_moment)
IF (ANY(ABS(err(1:3)) > 0.1_dp)) THEN
message = "A mismatch between analytical and numerical dipoles "// &
"has been detected. Check the implementation of the "// &
"analytical dipole calculation"
IF (stop_on_mismatch) THEN
CPABORT(message)
ELSE
CPWARN(message)
END IF
END IF
END IF
ELSE
CALL cp_warn(__LOCATION__, "Debug of dipole moments only for Quickstep code available")
END IF

6
src/cp_control_types.F
View file

@ -117,6 +117,7 @@ MODULE cp_control_types
LOGICAL :: xb_interaction
LOGICAL :: do_nonbonded
LOGICAL :: coulomb_interaction
LOGICAL :: coulomb_lr
LOGICAL :: tb3_interaction
LOGICAL :: check_atomic_charges
!
@ -441,6 +442,9 @@ MODULE cp_control_types
INTEGER :: nprocs
!> type of kernel function/approximation to use
INTEGER :: kernel
!> fro full kernel, do we have HFX/ADMM
LOGICAL :: do_hfx
LOGICAL :: do_admm
!> options used in sTDA calculation (Kernel)
TYPE(stda_control_type) :: stda_control
!> algorithm to correct orbital energies
@ -458,6 +462,8 @@ MODULE cp_control_types
LOGICAL :: is_restart
!> compute triplet excited states using spin-unpolarised molecular orbitals
LOGICAL :: rks_triplets
!> use symmetric definition of ADMM Kernel correction
LOGICAL :: admm_symm
!
! DIPOLE_MOMENTS subsection
!

3
src/cp_control_utils.F
View file

@ -1157,6 +1157,8 @@ CONTAINS
! 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, "COULOMB_LR", &
l_val=qs_control%xtb_control%coulomb_lr)
CALL section_vals_val_get(xtb_section, "TB3_INTERACTION", &
l_val=qs_control%xtb_control%tb3_interaction)
! Check for bad atomic charges
@ -1265,6 +1267,7 @@ CONTAINS
CALL section_vals_val_get(t_section, "RESTART", l_val=t_control%is_restart)
CALL section_vals_val_get(t_section, "RKS_TRIPLETS", l_val=t_control%rks_triplets)
CALL section_vals_val_get(t_section, "ADMM_KERNEL_CORRECTION_SYMMETRIC", l_val=t_control%admm_symm)
IF (t_control%conv < 0) &
t_control%conv = ABS(t_control%conv)

17
src/ec_env_types.F
View file

@ -13,6 +13,8 @@
! **************************************************************************************************
MODULE ec_env_types
USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set
USE cp_fm_types, ONLY: cp_fm_p_type,&
cp_fm_release
USE dbcsr_api, ONLY: dbcsr_p_type
USE dm_ls_scf_types, ONLY: ls_scf_env_type,&
ls_scf_release
@ -22,6 +24,8 @@ MODULE ec_env_types
pw_release
USE qs_dispersion_types, ONLY: qs_dispersion_release,&
qs_dispersion_type
USE qs_force_types, ONLY: deallocate_qs_force,&
qs_force_type
USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type,&
release_neighbor_list_sets
USE qs_p_env_types, ONLY: p_env_release,&
@ -66,6 +70,8 @@ MODULE ec_env_types
REAL(KIND=dp) :: etotal
REAL(KIND=dp) :: eband, exc, ehartree, vhxc
REAL(KIND=dp) :: edispersion, efield_nuclear
! forces
TYPE(qs_force_type), DIMENSION(:), POINTER :: force => Null()
! full neighbor lists and corresponding task list
TYPE(neighbor_list_set_p_type), &
DIMENSION(:), POINTER :: sab_orb, sac_ppl, sap_ppnl
@ -85,6 +91,7 @@ MODULE ec_env_types
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mao_coef
! CP equations
TYPE(qs_p_env_type), POINTER :: p_env
TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: cpmos
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hz, matrix_z, matrix_wz, z_admm
! potentials from input density
TYPE(pw_p_type), POINTER :: vh_rspace
@ -115,6 +122,8 @@ CONTAINS
CALL release_neighbor_list_sets(ec_env%sab_orb)
CALL release_neighbor_list_sets(ec_env%sac_ppl)
CALL release_neighbor_list_sets(ec_env%sap_ppnl)
! forces
IF (ASSOCIATED(ec_env%force)) CALL deallocate_qs_force(ec_env%force)
! operator matrices
IF (ASSOCIATED(ec_env%matrix_ks)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_ks)
IF (ASSOCIATED(ec_env%matrix_h)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_h)
@ -131,6 +140,14 @@ CONTAINS
IF (ASSOCIATED(ec_env%dispersion_env)) THEN
CALL qs_dispersion_release(ec_env%dispersion_env)
END IF
! CP env
IF (ASSOCIATED(ec_env%cpmos)) THEN
DO iab = 1, SIZE(ec_env%cpmos)
CALL cp_fm_release(ec_env%cpmos(iab)%matrix)
END DO
DEALLOCATE (ec_env%cpmos)
NULLIFY (ec_env%cpmos)
END IF
IF (ASSOCIATED(ec_env%matrix_z)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_z)
IF (ASSOCIATED(ec_env%matrix_hz)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_hz)

263
src/ec_environment.F
View file

@ -104,7 +104,8 @@ CONTAINS
SUBROUTINE init_ec_env(qs_env, ec_env, dft_section, ec_section)
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(energy_correction_type), POINTER :: ec_env
TYPE(section_vals_type), OPTIONAL, POINTER :: dft_section, ec_section
TYPE(section_vals_type), POINTER :: dft_section
TYPE(section_vals_type), OPTIONAL, POINTER :: ec_section
INTEGER :: ikind, maxlgto, nkind, unit_nr
LOGICAL :: explicit
@ -126,8 +127,10 @@ CONTAINS
NULLIFY (ec_env%matrix_t, ec_env%matrix_p, ec_env%matrix_w)
NULLIFY (ec_env%task_list)
NULLIFY (ec_env%mao_coef)
NULLIFY (ec_env%force)
NULLIFY (ec_env%dispersion_env)
NULLIFY (ec_env%xc_section)
NULLIFY (ec_env%cpmos)
NULLIFY (ec_env%matrix_z)
NULLIFY (ec_env%matrix_hz)
NULLIFY (ec_env%matrix_wz)
@ -140,140 +143,145 @@ CONTAINS
ec_env%should_update = .TRUE.
ec_env%mao = .FALSE.
! get a useful output_unit
logger => cp_get_default_logger()
IF (logger%para_env%ionode) THEN
unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
unit_nr = -1
ENDIF
IF (qs_env%energy_correction) THEN
CALL section_vals_val_get(ec_section, "ALGORITHM", &
i_val=ec_env%ks_solver)
CALL section_vals_val_get(ec_section, "ENERGY_FUNCTIONAL", &
i_val=ec_env%energy_functional)
CALL section_vals_val_get(ec_section, "FACTORIZATION", &
i_val=ec_env%factorization)
CALL section_vals_val_get(ec_section, "OT_INITIAL_GUESS", &
i_val=ec_env%ec_initial_guess)
CALL section_vals_val_get(ec_section, "EPS_DEFAULT", &
r_val=ec_env%eps_default)
CALL section_vals_val_get(ec_section, "HARRIS_BASIS", &
c_val=ec_env%basis)
CALL section_vals_val_get(ec_section, "MAO", &
l_val=ec_env%mao)
CALL section_vals_val_get(ec_section, "MAO_MAX_ITER", &
i_val=ec_env%mao_max_iter)
CALL section_vals_val_get(ec_section, "MAO_EPS_GRAD", &
r_val=ec_env%mao_eps_grad)
! Skip EC calculation if ground-state calculation did not converge
CALL section_vals_val_get(ec_section, "SKIP_EC", &
l_val=ec_env%skip_ec)
CPASSERT(PRESENT(ec_section))
! get a useful output_unit
logger => cp_get_default_logger()
IF (logger%para_env%ionode) THEN
unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
unit_nr = -1
ENDIF
ec_env%do_skip = .FALSE.
CALL section_vals_val_get(ec_section, "ALGORITHM", &
i_val=ec_env%ks_solver)
CALL section_vals_val_get(ec_section, "ENERGY_FUNCTIONAL", &
i_val=ec_env%energy_functional)
CALL section_vals_val_get(ec_section, "FACTORIZATION", &
i_val=ec_env%factorization)
CALL section_vals_val_get(ec_section, "OT_INITIAL_GUESS", &
i_val=ec_env%ec_initial_guess)
CALL section_vals_val_get(ec_section, "EPS_DEFAULT", &
r_val=ec_env%eps_default)
CALL section_vals_val_get(ec_section, "HARRIS_BASIS", &
c_val=ec_env%basis)
CALL section_vals_val_get(ec_section, "MAO", &
l_val=ec_env%mao)
CALL section_vals_val_get(ec_section, "MAO_MAX_ITER", &
i_val=ec_env%mao_max_iter)
CALL section_vals_val_get(ec_section, "MAO_EPS_GRAD", &
r_val=ec_env%mao_eps_grad)
! Skip EC calculation if ground-state calculation did not converge
CALL section_vals_val_get(ec_section, "SKIP_EC", &
l_val=ec_env%skip_ec)
! set basis
CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, nkind=nkind)
CALL uppercase(ec_env%basis)
SELECT CASE (ec_env%basis)
CASE ("ORBITAL")
DO ikind = 1, nkind
qs_kind => qs_kind_set(ikind)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=basis_set, basis_type="ORB")
IF (ASSOCIATED(basis_set)) THEN
ec_env%do_skip = .FALSE.
! set basis
CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, nkind=nkind)
CALL uppercase(ec_env%basis)
SELECT CASE (ec_env%basis)
CASE ("ORBITAL")
DO ikind = 1, nkind
qs_kind => qs_kind_set(ikind)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=basis_set, basis_type="ORB")
IF (ASSOCIATED(basis_set)) THEN
NULLIFY (harris_basis)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=harris_basis, basis_type="HARRIS")
IF (ASSOCIATED(harris_basis)) THEN
CALL remove_basis_from_container(qs_kind%basis_sets, basis_type="HARRIS")
END IF
NULLIFY (harris_basis)
CALL copy_gto_basis_set(basis_set, harris_basis)
CALL add_basis_set_to_container(qs_kind%basis_sets, harris_basis, "HARRIS")
END IF
END DO
CASE ("PRIMITIVE")
DO ikind = 1, nkind
qs_kind => qs_kind_set(ikind)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=basis_set, basis_type="ORB")
IF (ASSOCIATED(basis_set)) THEN
NULLIFY (harris_basis)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=harris_basis, basis_type="HARRIS")
IF (ASSOCIATED(harris_basis)) THEN
CALL remove_basis_from_container(qs_kind%basis_sets, basis_type="HARRIS")
END IF
NULLIFY (harris_basis)
CALL create_primitive_basis_set(basis_set, harris_basis)
CALL get_qs_env(qs_env, dft_control=dft_control)
eps_pgf_orb = dft_control%qs_control%eps_pgf_orb
CALL init_interaction_radii_orb_basis(harris_basis, eps_pgf_orb)
harris_basis%kind_radius = basis_set%kind_radius
CALL add_basis_set_to_container(qs_kind%basis_sets, harris_basis, "HARRIS")
END IF
END DO
CASE ("HARRIS")
DO ikind = 1, nkind
qs_kind => qs_kind_set(ikind)
NULLIFY (harris_basis)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=harris_basis, basis_type="HARRIS")
IF (ASSOCIATED(harris_basis)) THEN
CALL remove_basis_from_container(qs_kind%basis_sets, basis_type="HARRIS")
IF (.NOT. ASSOCIATED(harris_basis)) THEN
CPWARN("Harris Basis not defined for all types of atoms.")
END IF
NULLIFY (harris_basis)
CALL copy_gto_basis_set(basis_set, harris_basis)
CALL add_basis_set_to_container(qs_kind%basis_sets, harris_basis, "HARRIS")
END IF
END DO
CASE ("PRIMITIVE")
DO ikind = 1, nkind
qs_kind => qs_kind_set(ikind)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=basis_set, basis_type="ORB")
IF (ASSOCIATED(basis_set)) THEN
NULLIFY (harris_basis)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=harris_basis, basis_type="HARRIS")
IF (ASSOCIATED(harris_basis)) THEN
CALL remove_basis_from_container(qs_kind%basis_sets, basis_type="HARRIS")
END IF
NULLIFY (harris_basis)
CALL create_primitive_basis_set(basis_set, harris_basis)
CALL get_qs_env(qs_env, dft_control=dft_control)
eps_pgf_orb = dft_control%qs_control%eps_pgf_orb
CALL init_interaction_radii_orb_basis(harris_basis, eps_pgf_orb)
harris_basis%kind_radius = basis_set%kind_radius
CALL add_basis_set_to_container(qs_kind%basis_sets, harris_basis, "HARRIS")
END IF
END DO
CASE ("HARRIS")
DO ikind = 1, nkind
qs_kind => qs_kind_set(ikind)
NULLIFY (harris_basis)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=harris_basis, basis_type="HARRIS")
IF (.NOT. ASSOCIATED(harris_basis)) THEN
CPWARN("Harris Basis not defined for all types of atoms.")
END IF
END DO
CASE DEFAULT
CPABORT("Unknown basis set for energy correction (Harris functional)")
END SELECT
!
CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto, basis_type="HARRIS")
CALL init_orbital_pointers(maxlgto + 1)
! set functional
SELECT CASE (ec_env%energy_functional)
CASE (ec_functional_harris)
ec_env%ec_name = "Harris"
CASE DEFAULT
CPABORT("unknown energy correction")
END SELECT
! select the XC section
NULLIFY (xc_section)
xc_section => section_vals_get_subs_vals(dft_section, "XC")
section1 => section_vals_get_subs_vals(ec_section, "XC")
section2 => section_vals_get_subs_vals(ec_section, "XC%XC_FUNCTIONAL")
CALL section_vals_get(section2, explicit=explicit)
IF (explicit) THEN
CALL xc_functionals_expand(section2, section1)
ec_env%xc_section => section1
ELSE
ec_env%xc_section => xc_section
END IF
! dispersion
ALLOCATE (dispersion_env)
NULLIFY (xc_section)
xc_section => ec_env%xc_section
CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, para_env=para_env)
CALL qs_dispersion_env_set(dispersion_env, xc_section)
IF (dispersion_env%type == xc_vdw_fun_pairpot) THEN
NULLIFY (pp_section)
pp_section => section_vals_get_subs_vals(xc_section, "VDW_POTENTIAL%PAIR_POTENTIAL")
CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, pp_section, para_env)
ELSE IF (dispersion_env%type == xc_vdw_fun_nonloc) THEN
NULLIFY (nl_section)
nl_section => section_vals_get_subs_vals(xc_section, "VDW_POTENTIAL%NON_LOCAL")
CALL qs_dispersion_nonloc_init(dispersion_env, para_env)
END IF
ec_env%dispersion_env => dispersion_env
END DO
CASE DEFAULT
CPABORT("Unknown basis set for energy correction (Harris functional)")
END SELECT
!
CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto, basis_type="HARRIS")
CALL init_orbital_pointers(maxlgto + 1)
! set functional
SELECT CASE (ec_env%energy_functional)
CASE (ec_functional_harris)
ec_env%ec_name = "Harris"
CASE DEFAULT
CPABORT("unknown energy correction")
END SELECT
! select the XC section
NULLIFY (xc_section)
xc_section => section_vals_get_subs_vals(dft_section, "XC")
section1 => section_vals_get_subs_vals(ec_section, "XC")
section2 => section_vals_get_subs_vals(ec_section, "XC%XC_FUNCTIONAL")
CALL section_vals_get(section2, explicit=explicit)
IF (explicit) THEN
CALL xc_functionals_expand(section2, section1)
ec_env%xc_section => section1
ELSE
ec_env%xc_section => xc_section
END IF
! dispersion
ALLOCATE (dispersion_env)
NULLIFY (xc_section)
xc_section => ec_env%xc_section
CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, para_env=para_env)
CALL qs_dispersion_env_set(dispersion_env, xc_section)
IF (dispersion_env%type == xc_vdw_fun_pairpot) THEN
NULLIFY (pp_section)
pp_section => section_vals_get_subs_vals(xc_section, "VDW_POTENTIAL%PAIR_POTENTIAL")
CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, pp_section, para_env)
ELSE IF (dispersion_env%type == xc_vdw_fun_nonloc) THEN
NULLIFY (nl_section)
nl_section => section_vals_get_subs_vals(xc_section, "VDW_POTENTIAL%NON_LOCAL")
CALL qs_dispersion_nonloc_init(dispersion_env, para_env)
END IF
ec_env%dispersion_env => dispersion_env
! Initialize Harris LS solver environment
ec_env%use_ls_solver = .FALSE.
ec_env%use_ls_solver = (ec_env%ks_solver .EQ. ec_matrix_sign) &
.OR. (ec_env%ks_solver .EQ. ec_matrix_trs4) &
.OR. (ec_env%ks_solver .EQ. ec_matrix_tc2)
! Initialize Harris LS solver environment
ec_env%use_ls_solver = .FALSE.
ec_env%use_ls_solver = (ec_env%ks_solver .EQ. ec_matrix_sign) &
.OR. (ec_env%ks_solver .EQ. ec_matrix_trs4) &
.OR. (ec_env%ks_solver .EQ. ec_matrix_tc2)
IF (ec_env%use_ls_solver) THEN
CALL ec_ls_create(qs_env, ec_env)
END IF
IF (ec_env%use_ls_solver) THEN
CALL ec_ls_create(qs_env, ec_env)
END IF
! Write input
IF (unit_nr > 0) THEN
CALL ec_write_input(ec_env, unit_nr)
END IF
! Write input
IF (unit_nr > 0) THEN
CALL ec_write_input(ec_env, unit_nr)
END IF
END SUBROUTINE init_ec_env
@ -351,7 +359,7 @@ CONTAINS
CALL section_vals_val_get(ec_section, "EPS_LANCZOS", r_val=ls_env%eps_lanczos)
CALL section_vals_val_get(ec_section, "MAX_ITER_LANCZOS", i_val=ls_env%max_iter_lanczos)
SELECT CASE (qs_env%ec_env%ks_solver)
SELECT CASE (ec_env%ks_solver)
CASE (ec_matrix_sign)
! S inverse required for Sign matrix algorithm,
! calculated either by Hotelling or multiplying S matrix sqrt inv
@ -511,7 +519,6 @@ CONTAINS
CPABORT("Unknown sqrt method.")
END SELECT
WRITE (unit_nr, '(T2,A,T61,I20)') "S sqrt order:", ls_env%s_sqrt_order
END IF
SELECT CASE (ls_env%s_preconditioner_type)

15
src/ec_orth_solver.F
View file

@ -32,7 +32,8 @@ MODULE ec_orth_solver
ls_s_sqrt_ns,&
ls_s_sqrt_proot,&
precond_mlp
USE input_section_types, ONLY: section_vals_get_subs_vals,&
USE input_section_types, ONLY: section_vals_get,&
section_vals_get_subs_vals,&
section_vals_type,&
section_vals_val_get
USE iterate_matrix, ONLY: matrix_sqrt_Newton_Schulz,&
@ -1124,6 +1125,7 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'hessian_op2', routineP = moduleN//':'//routineN
INTEGER :: handle, ispin, nspins
LOGICAL :: do_hfx
REAL(KIND=dp) :: ekin_mol
TYPE(cp_para_env_type), POINTER :: para_env
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_G, matrix_s, rho1_ao, rho_ao
@ -1136,7 +1138,7 @@ CONTAINS
TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
TYPE(qs_rho_type), POINTER :: rho
TYPE(section_vals_type), POINTER :: input, xc_section
TYPE(section_vals_type), POINTER :: hfx_section, input, xc_section
CALL timeset(routineN, handle)
@ -1184,6 +1186,15 @@ CONTAINS
NULLIFY (v_xc, xc_section)
xc_section => section_vals_get_subs_vals(input, "DFT%XC")
! No HFX allowed
hfx_section => section_vals_get_subs_vals(xc_section, "HF")
CALL section_vals_get(hfx_section, explicit=do_hfx)
IF (do_hfx) THEN
CALL cp_warn(__LOCATION__, "HFX not possible with AO based response solver. "// &
"Use the MO solver: RESPONSE_SOLVER/METOD MO_SOLVER")
CPABORT("hessian_op2@ec_orth_solver")
END IF
! add xc-kernel
CALL create_kernel(qs_env, &
vxc=v_xc, &

2
src/emd/rt_propagation_utils.F
View file

@ -43,6 +43,7 @@ MODULE rt_propagation_utils
USE mathconstants, ONLY: zero
USE orbital_pointers, ONLY: ncoset
USE particle_types, ONLY: particle_type
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_dftb_matrices, ONLY: build_dftb_overlap
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
@ -51,7 +52,6 @@ MODULE rt_propagation_utils
qs_ks_env_type
USE qs_mo_io, ONLY: read_mo_set_from_restart,&
read_rt_mos_from_restart
USE qs_mo_methods, ONLY: calculate_density_matrix
USE qs_mo_types, ONLY: mo_set_p_type
USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
USE qs_overlap, ONLY: build_overlap_matrix

56
src/energy_corrections.F
View file

@ -124,6 +124,8 @@ MODULE energy_corrections
USE qs_collocate_density, ONLY: calculate_rho_elec
USE qs_core_energies, ONLY: calculate_ecore_overlap,&
calculate_ptrace
USE qs_density_matrices, ONLY: calculate_density_matrix,&
calculate_w_matrix
USE qs_dispersion_pairpot, ONLY: calculate_dispersion_pairpot
USE qs_dispersion_types, ONLY: qs_dispersion_type
USE qs_energy_types, ONLY: qs_energy_type
@ -139,11 +141,9 @@ MODULE energy_corrections
get_qs_kind_set,&
qs_kind_type
USE qs_kinetic, ONLY: build_kinetic_matrix
USE qs_ks_methods, ONLY: calc_rho_tot_gspace,&
calculate_w_matrix
USE qs_ks_methods, ONLY: calc_rho_tot_gspace
USE qs_ks_types, ONLY: qs_ks_env_type
USE qs_mo_methods, ONLY: calculate_density_matrix,&
calculate_subspace_eigenvalues,&
USE qs_mo_methods, ONLY: calculate_subspace_eigenvalues,&
make_basis_sm
USE qs_mo_types, ONLY: deallocate_mo_set,&
get_mo_set,&
@ -185,7 +185,7 @@ MODULE energy_corrections
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'energy_corrections'
LOGICAL, PARAMETER :: debug_forces = .FALSE.
LOGICAL, PARAMETER :: debug_forces = .TRUE.
LOGICAL, PARAMETER :: debug_stress = .FALSE.
PUBLIC :: energy_correction
@ -268,11 +268,9 @@ CONTAINS
!
IF (ec_env%should_update) THEN
energy%nonscf_correction = ec_env%etotal - energy%total
energy%total = energy%total + energy%nonscf_correction
CALL evaluate_ec_core_matrix_traces(qs_env, ec_env)
energy%total = ec_env%etotal
END IF
CASE DEFAULT
CPABORT("unknown energy correction")
END SELECT
@ -390,8 +388,10 @@ CONTAINS
vadmm_rspace=ec_env%vadmm_rspace, &
matrix_hz=ec_env%matrix_hz, &
matrix_pz=ec_env%matrix_z, &
matrix_pz_admm=ec_env%z_admm, &
matrix_wz=ec_env%matrix_wz, &
zehartree=ec_env%ehartree, &
p_env=ec_env%p_env, &
zexc=ec_env%exc)
CALL ec_properties(qs_env, ec_env)
@ -461,7 +461,11 @@ CONTAINS
CALL timeset(routineN, handle)
logger => cp_get_default_logger()
iounit = cp_logger_get_default_unit_nr(logger)
IF (logger%para_env%ionode) THEN
iounit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
iounit = -1
ENDIF
! no k-points possible
CALL get_qs_env(qs_env=qs_env, &
@ -569,7 +573,11 @@ CONTAINS
CALL timeset(routineN, handle)
logger => cp_get_default_logger()
iounit = cp_logger_get_default_unit_nr(logger)
IF (logger%para_env%ionode) THEN
iounit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
iounit = -1
ENDIF
calculate_forces = .FALSE.
@ -711,7 +719,11 @@ CONTAINS
CALL timeset(routineN, handle)
logger => cp_get_default_logger()
iounit = cp_logger_get_default_unit_nr(logger)
IF (logger%para_env%ionode) THEN
iounit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
iounit = -1
ENDIF
IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "ec_build_core_hamiltonian_force - START"
@ -771,7 +783,7 @@ CONTAINS
sab_nl=sab_orb, calculate_forces=.TRUE., &
matrixkp_p=ec_env%matrix_w)
IF (debug_forces) THEN
fodeb(1:3) = fconv*(force(1)%overlap(1:3, 1) - fodeb(1:3))
fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
CALL mp_sum(fodeb, para_env%group)
IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Wout*dS ", fodeb
fodeb(1:3) = force(1)%kinetic(1:3, 1)
@ -919,13 +931,17 @@ CONTAINS
TYPE(qs_force_type), DIMENSION(:), POINTER :: force
TYPE(qs_ks_env_type), POINTER :: ks_env
TYPE(qs_rho_type), POINTER :: rho
TYPE(section_vals_type), POINTER :: input, xc_section
TYPE(section_vals_type), POINTER :: xc_section
TYPE(virial_type), POINTER :: virdeb, virial
CALL timeset(routineN, handle)
logger => cp_get_default_logger()
iounit = cp_logger_get_default_unit_nr(logger)
IF (logger%para_env%ionode) THEN
iounit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
iounit = -1
ENDIF
! get all information on the electronic density
NULLIFY (atomic_kind_set, blacs_env, cell, dft_control, force, ks_env, &
@ -1125,7 +1141,7 @@ CONTAINS
! Pulay force from Tr P_in (V_H(drho)+ Fxc(rho_in)*drho)
! RHS of CPKS equations: (V_H(drho)+ Fxc(rho_in)*drho)*C0
! Fxc*drho term
CALL get_qs_env(qs_env, input=input)
NULLIFY (v_xc)
xc_section => ec_env%xc_section
IF (use_virial) virial%pv_xc = 0.0_dp
@ -1190,7 +1206,6 @@ CONTAINS
WRITE (UNIT=iounit, FMT="(T2,A,T41,2(1X,ES19.11))") &
'STRESS| INT 2nd f_Hxc[dP]*Pin ', one_third_sum_diag(stdeb), det_3x3(stdeb)
END IF
! Stress-tensor 2nd derivative integral contribution
IF (use_virial) THEN
virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
@ -1919,7 +1934,6 @@ CONTAINS
CALL build_neighbor_lists(sab_vdw, particle_set, atom2d, cell, pair_radius, &
subcells=subcells, operator_type="PP", nlname="sab_vdw")
dispersion_env%sab_vdw => sab_vdw
IF (dispersion_env%pp_type == vdw_pairpot_dftd3 .OR. &
dispersion_env%pp_type == vdw_pairpot_dftd3bj) THEN
! Build the neighbor lists for coordination numbers as needed by the DFT-D3 method
@ -1938,7 +1952,7 @@ CONTAINS
CALL atom2d_cleanup(atom2d)
DEALLOCATE (atom2d)
DEALLOCATE (orb_present, default_present, ppl_present, ppnl_present)
DEALLOCATE (c_radius, orb_radius, ppl_radius, ppnl_radius)
DEALLOCATE (orb_radius, ppl_radius, ppnl_radius, c_radius)
DEALLOCATE (pair_radius)
! Task list
@ -1992,7 +2006,11 @@ CONTAINS
rlab(3) = "Z"
logger => cp_get_default_logger()
iounit = cp_logger_get_default_unit_nr(logger)
IF (logger%para_env%ionode) THEN
iounit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
iounit = -1
ENDIF
print_key => section_vals_get_subs_vals(section_vals=qs_env%input, &
subsection_name="DFT%PRINT%MOMENTS")

170
src/ewald_methods_tb.F
View file

@ -65,7 +65,7 @@ MODULE ewald_methods_tb
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ewald_methods_tb'
PUBLIC :: tb_spme_evaluate, tb_ewald_overlap
PUBLIC :: tb_spme_evaluate, tb_ewald_overlap, tb_spme_zforce
CONTAINS
@ -408,5 +408,173 @@ CONTAINS
END SUBROUTINE tb_ewald_overlap
! **************************************************************************************************
!> \brief ...
!> \param ewald_env ...
!> \param ewald_pw ...
!> \param particle_set ...
!> \param box ...
!> \param gmcharge ...
!> \param mcharge ...
! **************************************************************************************************
SUBROUTINE tb_spme_zforce(ewald_env, ewald_pw, particle_set, box, gmcharge, mcharge)
TYPE(ewald_environment_type), POINTER :: ewald_env
TYPE(ewald_pw_type), POINTER :: ewald_pw
TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
TYPE(cell_type), POINTER :: box
REAL(KIND=dp), DIMENSION(:, :), INTENT(inout) :: gmcharge
REAL(KIND=dp), DIMENSION(:), INTENT(in) :: mcharge
CHARACTER(len=*), PARAMETER :: routineN = 'tb_spme_zforce'
INTEGER :: group, handle, i, ipart, n, npart, &
o_spline, p1
INTEGER, ALLOCATABLE, DIMENSION(:, :) :: center
INTEGER, DIMENSION(3) :: npts
REAL(KIND=dp) :: alpha, dvols, fat(3), fint, vgc
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: rhos
TYPE(cp_para_env_type), POINTER :: para_env
TYPE(greens_fn_type), POINTER :: green
TYPE(pw_grid_type), POINTER :: grid_spme
TYPE(pw_p_type), DIMENSION(3) :: dphi_g
TYPE(pw_poisson_type), POINTER :: poisson_env
TYPE(pw_pool_type), POINTER :: pw_pool
TYPE(pw_type), POINTER :: phi_g, rhob_g, rhob_r
TYPE(realspace_grid_desc_type), POINTER :: rs_desc
TYPE(realspace_grid_p_type), DIMENSION(:), POINTER :: drpot
TYPE(realspace_grid_type), POINTER :: rden, rpot
CALL timeset(routineN, handle)
!-------------- INITIALISATION ---------------------
CALL ewald_env_get(ewald_env, alpha=alpha, o_spline=o_spline, group=group, &
para_env=para_env)
NULLIFY (green, poisson_env, pw_pool)
CALL ewald_pw_get(ewald_pw, pw_big_pool=pw_pool, rs_desc=rs_desc, &
poisson_env=poisson_env)
CALL pw_poisson_rebuild(poisson_env)
green => poisson_env%green_fft
grid_spme => pw_pool%pw_grid
CALL get_pw_grid_info(grid_spme, dvol=dvols, npts=npts)
npart = SIZE(particle_set)
n = o_spline
ALLOCATE (rhos(n, n, n))
CALL rs_grid_create(rden, rs_desc)
CALL rs_grid_set_box(grid_spme, rs=rden)
CALL rs_grid_zero(rden)
ALLOCATE (center(3, npart))
CALL get_center(particle_set, box, center, npts, n)
!-------------- DENSITY CALCULATION ----------------
ipart = 0
DO
CALL set_list(particle_set, npart, center, p1, rden, ipart)
IF (p1 == 0) EXIT
! calculate function on small boxes
CALL get_patch(particle_set, box, green, npts, p1, rhos, is_core=.FALSE., &
is_shell=.FALSE., unit_charge=.TRUE.)
rhos(:, :, :) = rhos(:, :, :)*mcharge(p1)
! add boxes to real space grid (big box)
CALL dg_sum_patch(rden, rhos, center(:, p1))
END DO
CALL pw_pool_create_pw(pw_pool, rhob_r, use_data=REALDATA3D, &
in_space=REALSPACE)
CALL rs_pw_transfer(rden, rhob_r, rs2pw)
! transform density to G space and add charge function
CALL pw_pool_create_pw(pw_pool, rhob_g, use_data=COMPLEXDATA1D, &
in_space=RECIPROCALSPACE)
CALL pw_transfer(rhob_r, rhob_g)
! update charge function
rhob_g%cc = rhob_g%cc*green%p3m_charge%cr
!-------------- ELECTROSTATIC CALCULATION -----------
! allocate intermediate arrays
DO i = 1, 3
NULLIFY (dphi_g(i)%pw)
CALL pw_pool_create_pw(pw_pool, dphi_g(i)%pw, &
use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE)
END DO
CALL pw_pool_create_pw(pw_pool, phi_g, &
use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE)
CALL pw_poisson_solve(poisson_env, rhob_g, vgc, phi_g, dphi_g)
CALL rs_grid_create(rpot, rs_desc)
CALL rs_grid_set_box(grid_spme, rs=rpot)
CALL pw_pool_give_back_pw(pw_pool, rhob_g)
CALL rs_grid_zero(rpot)
phi_g%cc = phi_g%cc*green%p3m_charge%cr
CALL pw_transfer(phi_g, rhob_r)
CALL pw_pool_give_back_pw(pw_pool, phi_g)
CALL rs_pw_transfer(rpot, rhob_r, pw2rs)
!---------- END OF ELECTROSTATIC CALCULATION --------
! move derivative of potential to real space grid and
! multiply by charge function in g-space
ALLOCATE (drpot(1:3))
DO i = 1, 3
CALL rs_grid_create(drpot(i)%rs_grid, rs_desc)
CALL rs_grid_set_box(grid_spme, rs=drpot(i)%rs_grid)
dphi_g(i)%pw%cc = dphi_g(i)%pw%cc*green%p3m_charge%cr
CALL pw_transfer(dphi_g(i)%pw, rhob_r)
CALL pw_pool_give_back_pw(pw_pool, dphi_g(i)%pw)
CALL rs_pw_transfer(drpot(i)%rs_grid, rhob_r, pw2rs)
END DO
CALL pw_pool_give_back_pw(pw_pool, rhob_r)
!----------------- FORCE CALCULATION ----------------
ipart = 0
DO
CALL set_list(particle_set, npart, center, p1, rden, ipart)
IF (p1 == 0) EXIT
! calculate function on small boxes
CALL get_patch(particle_set, box, green, npts, p1, rhos, is_core=.FALSE., &
is_shell=.FALSE., unit_charge=.TRUE.)
CALL dg_sum_patch_force_1d(rpot, rhos, center(:, p1), fint)
gmcharge(p1, 1) = gmcharge(p1, 1) + fint*dvols
CALL dg_sum_patch_force_3d(drpot, rhos, center(:, p1), fat)
gmcharge(p1, 2) = gmcharge(p1, 2) - fat(1)*dvols
gmcharge(p1, 3) = gmcharge(p1, 3) - fat(2)*dvols
gmcharge(p1, 4) = gmcharge(p1, 4) - fat(3)*dvols
END DO
!--------------END OF FORCE CALCULATION -------------
!------------------CLEANING UP ----------------------
CALL rs_grid_release(rden)
CALL rs_grid_release(rpot)
IF (ASSOCIATED(drpot)) THEN
DO i = 1, 3
CALL rs_grid_release(drpot(i)%rs_grid)
END DO
DEALLOCATE (drpot)
END IF
DEALLOCATE (rhos)
DEALLOCATE (center)
CALL timestop(handle)
END SUBROUTINE tb_spme_zforce
END MODULE ewald_methods_tb

274
src/ex_property_calculation.F Normal file
View file

@ -0,0 +1,274 @@
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2021 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
!> \brief Routines for property calculations of excited states
!> \par History
!> 02.2020 Adapted from ec_properties
!> \author JGH
! **************************************************************************************************
MODULE ex_property_calculation
USE atomic_kind_types, ONLY: atomic_kind_type,&
get_atomic_kind
USE cell_types, ONLY: cell_type,&
pbc
USE cp_control_types, ONLY: dft_control_type
USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set,&
dbcsr_deallocate_matrix_set
USE cp_log_handling, ONLY: cp_get_default_logger,&
cp_logger_get_default_unit_nr,&
cp_logger_type
USE cp_output_handling, ONLY: cp_p_file,&
cp_print_key_finished_output,&
cp_print_key_should_output,&
cp_print_key_unit_nr
USE cp_para_types, ONLY: cp_para_env_type
USE cp_result_methods, ONLY: cp_results_erase,&
put_results
USE cp_result_types, ONLY: cp_result_type
USE dbcsr_api, ONLY: dbcsr_add,&
dbcsr_copy,&
dbcsr_create,&
dbcsr_dot,&
dbcsr_p_type,&
dbcsr_release,&
dbcsr_set,&
dbcsr_type
USE distribution_1d_types, ONLY: distribution_1d_type
USE input_section_types, ONLY: section_get_ival,&
section_get_lval,&
section_vals_get_subs_vals,&
section_vals_type,&
section_vals_val_get
USE kinds, ONLY: default_path_length,&
default_string_length,&
dp
USE message_passing, ONLY: mp_sum
USE moments_utils, ONLY: get_reference_point
USE mulliken, ONLY: mulliken_charges
USE particle_types, ONLY: particle_type
USE physcon, ONLY: debye
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
USE qs_kind_types, ONLY: get_qs_kind,&
qs_kind_type
USE qs_moments, ONLY: build_local_moment_matrix
USE qs_p_env_types, ONLY: qs_p_env_type
USE qs_rho_types, ONLY: qs_rho_get,&
qs_rho_type
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
! *** Global parameters ***
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ex_property_calculation'
PUBLIC :: ex_properties
CONTAINS
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param matrix_pe ...
!> \param p_env ...
! **************************************************************************************************
SUBROUTINE ex_properties(qs_env, matrix_pe, p_env)
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_pe
TYPE(qs_p_env_type), POINTER :: p_env
CHARACTER(LEN=*), PARAMETER :: routineN = 'ex_properties', routineP = moduleN//':'//routineN
CHARACTER(LEN=8), DIMENSION(3) :: rlab
CHARACTER(LEN=default_path_length) :: filename
CHARACTER(LEN=default_string_length) :: description
INTEGER :: akind, handle, i, ia, iatom, idir, &
ikind, iounit, ispin, maxmom, natom, &
nspins, reference, unit_nr
LOGICAL :: magnetic, periodic, tb
REAL(KIND=dp) :: charge, dd, q, tmp
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: mcharge
REAL(KIND=dp), DIMENSION(3) :: cdip, pdip, pedip, rcc, rdip, ria, tdip
REAL(KIND=dp), DIMENSION(:), POINTER :: ref_point
TYPE(atomic_kind_type), POINTER :: atomic_kind
TYPE(cell_type), POINTER :: cell
TYPE(cp_logger_type), POINTER :: logger
TYPE(cp_para_env_type), POINTER :: para_env
TYPE(cp_result_type), POINTER :: results
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_p, matrix_s, moments
TYPE(dbcsr_type), POINTER :: matrix_pall
TYPE(dft_control_type), POINTER :: dft_control
TYPE(distribution_1d_type), POINTER :: local_particles
TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
TYPE(qs_rho_type), POINTER :: rho
TYPE(section_vals_type), POINTER :: print_key
CALL timeset(routineN, handle)
rlab(1) = "X"
rlab(2) = "Y"
rlab(3) = "Z"
CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
tb = (dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb)
logger => cp_get_default_logger()
IF (logger%para_env%ionode) THEN
iounit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
iounit = -1
ENDIF
print_key => section_vals_get_subs_vals(section_vals=qs_env%input, &
subsection_name="DFT%PRINT%MOMENTS")
IF (BTEST(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
maxmom = section_get_ival(section_vals=qs_env%input, &
keyword_name="DFT%PRINT%MOMENTS%MAX_MOMENT")
periodic = section_get_lval(section_vals=qs_env%input, &
keyword_name="DFT%PRINT%MOMENTS%PERIODIC")
reference = section_get_ival(section_vals=qs_env%input, &
keyword_name="DFT%PRINT%MOMENTS%REFERENCE")
magnetic = section_get_lval(section_vals=qs_env%input, &
keyword_name="DFT%PRINT%MOMENTS%MAGNETIC")
NULLIFY (ref_point)
CALL section_vals_val_get(qs_env%input, "DFT%PRINT%MOMENTS%REF_POINT", r_vals=ref_point)
unit_nr = cp_print_key_unit_nr(logger=logger, basis_section=qs_env%input, &
print_key_path="DFT%PRINT%MOMENTS", extension=".dat", &
middle_name="moments", log_filename=.FALSE.)
IF (iounit > 0) THEN
IF (unit_nr /= iounit .AND. unit_nr > 0) THEN
INQUIRE (UNIT=unit_nr, NAME=filename)
WRITE (UNIT=iounit, FMT="(/,T2,A,2(/,T3,A),/)") &
"MOMENTS", "The electric/magnetic moments are written to file:", &
TRIM(filename)
ELSE
WRITE (UNIT=iounit, FMT="(/,T2,A)") "ELECTRIC/MAGNETIC MOMENTS"
END IF
END IF
IF (periodic) THEN
CPABORT("Periodic moments not implemented with TDDFT")
ELSE
CPASSERT(maxmom < 2)
CPASSERT(.NOT. magnetic)
IF (maxmom == 1) THEN
CALL get_qs_env(qs_env=qs_env, cell=cell, para_env=para_env)
! reference point
CALL get_reference_point(rcc, qs_env=qs_env, reference=reference, ref_point=ref_point)
! nuclear contribution
cdip = 0.0_dp
CALL get_qs_env(qs_env=qs_env, particle_set=particle_set, &
qs_kind_set=qs_kind_set, local_particles=local_particles)
DO ikind = 1, SIZE(local_particles%n_el)
DO ia = 1, local_particles%n_el(ikind)
iatom = local_particles%list(ikind)%array(ia)
! fold atomic positions back into unit cell
ria = pbc(particle_set(iatom)%r - rcc, cell) + rcc
ria = ria - rcc
atomic_kind => particle_set(iatom)%atomic_kind
CALL get_atomic_kind(atomic_kind, kind_number=akind)
CALL get_qs_kind(qs_kind_set(akind), core_charge=charge)
cdip(1:3) = cdip(1:3) - charge*ria(1:3)
END DO
END DO
CALL mp_sum(cdip, para_env%group)
!
! electronic contribution
CALL get_qs_env(qs_env=qs_env, rho=rho, matrix_s=matrix_s)
CALL qs_rho_get(rho, rho_ao=matrix_p)
nspins = SIZE(matrix_p, 1)
IF (tb) THEN
ALLOCATE (matrix_pall)
CALL dbcsr_create(matrix_pall, template=matrix_s(1)%matrix)
CALL dbcsr_copy(matrix_pall, matrix_s(1)%matrix, "Moments")
CALL dbcsr_set(matrix_pall, 0.0_dp)
DO ispin = 1, nspins
CALL dbcsr_add(matrix_pall, matrix_p(ispin)%matrix, 1.0_dp, 1.0_dp)
CALL dbcsr_add(matrix_pall, matrix_pe(ispin)%matrix, 1.0_dp, 1.0_dp)
CALL dbcsr_add(matrix_pall, p_env%p1(ispin)%matrix, 1.0_dp, 1.0_dp)
END DO
CALL get_qs_env(qs_env=qs_env, natom=natom)
! Mulliken charges
ALLOCATE (mcharge(natom))
!
CALL mulliken_charges(matrix_pall, matrix_s(1)%matrix, para_env, mcharge)
!
rdip = 0.0_dp
pdip = 0.0_dp
pedip = 0.0_dp
DO i = 1, SIZE(particle_set)
ria = pbc(particle_set(i)%r - rcc, cell) + rcc
ria = ria - rcc
q = mcharge(i)
rdip = rdip + q*ria
END DO
CALL dbcsr_release(matrix_pall)
DEALLOCATE (matrix_pall)
DEALLOCATE (mcharge)
ELSE
! KS-DFT
NULLIFY (moments)
CALL dbcsr_allocate_matrix_set(moments, 4)
DO i = 1, 4
ALLOCATE (moments(i)%matrix)
CALL dbcsr_copy(moments(i)%matrix, matrix_s(1)%matrix, "Moments")
CALL dbcsr_set(moments(i)%matrix, 0.0_dp)
END DO
CALL build_local_moment_matrix(qs_env, moments, 1, ref_point=rcc)
!
rdip = 0.0_dp
pdip = 0.0_dp
pedip = 0.0_dp
DO ispin = 1, nspins
DO idir = 1, 3
CALL dbcsr_dot(matrix_pe(ispin)%matrix, moments(idir)%matrix, tmp)
pedip(idir) = pedip(idir) + tmp
CALL dbcsr_dot(matrix_p(ispin)%matrix, moments(idir)%matrix, tmp)
pdip(idir) = pdip(idir) + tmp
CALL dbcsr_dot(p_env%p1(ispin)%matrix, moments(idir)%matrix, tmp)
rdip(idir) = rdip(idir) + tmp
END DO
END DO
CALL dbcsr_deallocate_matrix_set(moments)
END IF
!
IF (unit_nr > 0) THEN
tdip = -(rdip + pedip + pdip + cdip)
WRITE (unit_nr, "(T3,A)") "Dipoles are based on the traditional operator."
dd = SQRT(SUM(tdip(1:3)**2))*debye
WRITE (unit_nr, "(T3,A)") "Dipole moment [Debye]"
WRITE (unit_nr, "(T5,3(A,A,F14.8,1X),T60,A,T67,F14.8)") &
(TRIM(rlab(i)), "=", tdip(i)*debye, i=1, 3), "Total=", dd
WRITE (unit_nr, FMT="(T2,A,T61,E20.12)") ' DIPOLE : CheckSum =', SUM(ABS(tdip))
END IF
ENDIF
END IF
CALL get_qs_env(qs_env=qs_env, results=results)
description = "[DIPOLE]"
CALL cp_results_erase(results=results, description=description)
CALL put_results(results=results, description=description, values=tdip(1:3))
CALL cp_print_key_finished_output(unit_nr=unit_nr, logger=logger, &
basis_section=qs_env%input, print_key_path="DFT%PRINT%MOMENTS")
END IF
CALL timestop(handle)
END SUBROUTINE ex_properties
! **************************************************************************************************
END MODULE ex_property_calculation

160
src/excited_states.F Normal file
View file

@ -0,0 +1,160 @@
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2021 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
!> \brief Routines for total energy and forces of excited states
!> \par History
!> 01.2020 created
!> \author JGH
! **************************************************************************************************
MODULE excited_states
USE atomic_kind_types, ONLY: atomic_kind_type,&
get_atomic_kind_set
USE cp_control_types, ONLY: dft_control_type
USE cp_log_handling, ONLY: cp_get_default_logger,&
cp_logger_get_default_unit_nr,&
cp_logger_type
USE ex_property_calculation, ONLY: ex_properties
USE exstates_types, ONLY: excited_energy_type
USE qs_energy_types, ONLY: qs_energy_type
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type,&
set_qs_env
USE qs_force_types, ONLY: allocate_qs_force,&
deallocate_qs_force,&
qs_force_type,&
sum_qs_force,&
zero_qs_force
USE qs_p_env_types, ONLY: p_env_release,&
qs_p_env_type
USE response_solver, ONLY: response_equation,&
response_force,&
response_force_xtb
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
! *** Global parameters ***
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'excited_states'
LOGICAL, PARAMETER :: debug_forces = .TRUE.
PUBLIC :: excited_state_energy
CONTAINS
! **************************************************************************************************
!> \brief Excited state energy and forces
!>
!> \param qs_env ...
!> \param calculate_forces ...
!> \par History
!> 03.2014 created
!> \author JGH
! **************************************************************************************************
SUBROUTINE excited_state_energy(qs_env, calculate_forces)
TYPE(qs_environment_type), POINTER :: qs_env
LOGICAL, INTENT(IN), OPTIONAL :: calculate_forces
CHARACTER(len=*), PARAMETER :: routineN = 'excited_state_energy', &
routineP = moduleN//':'//routineN
INTEGER :: handle, nkind, unit_nr
INTEGER, ALLOCATABLE, DIMENSION(:) :: natom_of_kind
TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
TYPE(cp_logger_type), POINTER :: logger
TYPE(dft_control_type), POINTER :: dft_control
TYPE(excited_energy_type), POINTER :: ex_env
TYPE(qs_energy_type), POINTER :: energy
TYPE(qs_force_type), DIMENSION(:), POINTER :: ks_force, lr_force
TYPE(qs_p_env_type), POINTER :: p_env
CALL timeset(routineN, handle)
! Check for energy correction
IF (qs_env%excited_state) THEN
logger => cp_get_default_logger()
IF (logger%para_env%ionode) THEN
unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
unit_nr = -1
ENDIF
CALL get_qs_env(qs_env, exstate_env=ex_env, energy=energy)
energy%excited_state = ex_env%evalue
energy%total = energy%total + ex_env%evalue
IF (calculate_forces) THEN
IF (unit_nr > 0) THEN
WRITE (unit_nr, '(T2,A,A,A,A,A)') "!", REPEAT("-", 27), &
" Excited State Forces ", REPEAT("-", 28), "!"
END IF
! prepare force array
CALL get_qs_env(qs_env, force=ks_force, atomic_kind_set=atomic_kind_set)
nkind = SIZE(atomic_kind_set)
ALLOCATE (natom_of_kind(nkind))
CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, natom_of_kind=natom_of_kind)
NULLIFY (lr_force)
CALL allocate_qs_force(lr_force, natom_of_kind)
DEALLOCATE (natom_of_kind)
CALL zero_qs_force(lr_force)
CALL set_qs_env(qs_env, force=lr_force)
!
NULLIFY (p_env)
CALL response_equation(qs_env, p_env, ex_env%cpmos, unit_nr)
!
CALL get_qs_env(qs_env, dft_control=dft_control)
IF (dft_control%qs_control%semi_empirical) THEN
CPABORT("Not available")
ELSEIF (dft_control%qs_control%dftb) THEN
CPABORT("Not available")
ELSEIF (dft_control%qs_control%xtb) THEN
CALL response_force_xtb(qs_env, p_env, ex_env%matrix_hz, ex_env)
ELSE
! KS-DFT
CALL response_force(qs_env=qs_env, vh_rspace=ex_env%vh_rspace, &
vxc_rspace=ex_env%vxc_rspace, vtau_rspace=ex_env%vtau_rspace, &
vadmm_rspace=ex_env%vadmm_rspace, matrix_hz=ex_env%matrix_hz, &
matrix_pz=ex_env%matrix_px1, matrix_pz_admm=p_env%p1_admm, &
matrix_wz=p_env%w1, &
p_env=p_env, ex_env=ex_env)
END IF
! add TD and KS forces
CALL get_qs_env(qs_env, force=lr_force)
CALL sum_qs_force(ks_force, lr_force)
CALL set_qs_env(qs_env, force=ks_force)
CALL deallocate_qs_force(lr_force)
!
CALL ex_properties(qs_env, ex_env%matrix_pe, p_env)
!
CALL p_env_release(p_env)
!
ELSE
IF (unit_nr > 0) THEN
WRITE (unit_nr, '(T2,A,A,A,A,A)') "!", REPEAT("-", 27), &
" Excited State Energy ", REPEAT("-", 28), "!"
WRITE (unit_nr, '(T2,A,T65,F16.10)') "Excitation Energy [Hartree] ", ex_env%evalue
WRITE (unit_nr, '(T2,A,T65,F16.10)') "Total Energy [Hartree]", energy%total
END IF
END IF
IF (unit_nr > 0) THEN
WRITE (unit_nr, '(T2,A,A,A)') "!", REPEAT("-", 77), "!"
END IF
END IF
CALL timestop(handle)
END SUBROUTINE excited_state_energy
! **************************************************************************************************
END MODULE excited_states

158
src/exstates_types.F Normal file
View file

@ -0,0 +1,158 @@
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2021 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
!> \brief Types for excited states potential energies
!> \par History
!> 2020.01 created
!> \author JGH
! **************************************************************************************************
MODULE exstates_types
USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set
USE cp_fm_types, ONLY: cp_fm_p_type,&
cp_fm_release
USE dbcsr_api, ONLY: dbcsr_p_type
USE input_section_types, ONLY: section_vals_type,&
section_vals_val_get
USE kinds, ONLY: dp
USE pw_types, ONLY: pw_p_type,&
pw_release
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'exstates_types'
PUBLIC :: excited_energy_type, exstate_release, exstate_create
! *****************************************************************************
!> \brief Contains information on the excited states energy
!> \par History
!> 01.2020 created
!> \author JGH
! *****************************************************************************
TYPE excited_energy_type
INTEGER :: state
REAL(KIND=dp) :: evalue
INTEGER :: xc_kernel_method
TYPE(cp_fm_p_type), POINTER, DIMENSION(:) :: evect => NULL()
TYPE(cp_fm_p_type), POINTER, DIMENSION(:) :: cpmos => NULL()
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_pe => NULL()
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hz => NULL()
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_pe_admm => NULL()
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_px1 => NULL()
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_px1_admm => NULL()
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_wx1 => NULL()
TYPE(pw_p_type), POINTER :: vh_rspace => NULL()
TYPE(pw_p_type), DIMENSION(:), POINTER :: vxc_rspace => NULL()
TYPE(pw_p_type), DIMENSION(:), POINTER :: vtau_rspace => NULL()
TYPE(pw_p_type), DIMENSION(:), POINTER :: vadmm_rspace => NULL()
END TYPE excited_energy_type
CONTAINS
! **************************************************************************************************
!> \brief ...
!> \param ex_env ...
! **************************************************************************************************
SUBROUTINE exstate_release(ex_env)
TYPE(excited_energy_type), POINTER :: ex_env
CHARACTER(LEN=*), PARAMETER :: routineN = 'exstate_release', &
routineP = moduleN//':'//routineN
INTEGER :: iab, is
IF (ASSOCIATED(ex_env)) THEN
IF (ASSOCIATED(ex_env%evect)) THEN
DO is = 1, SIZE(ex_env%evect)
CALL cp_fm_release(ex_env%evect(is)%matrix)
END DO
DEALLOCATE (ex_env%evect)
END IF
IF (ASSOCIATED(ex_env%cpmos)) THEN
DO is = 1, SIZE(ex_env%cpmos)
CALL cp_fm_release(ex_env%cpmos(is)%matrix)
END DO
DEALLOCATE (ex_env%cpmos)
END IF
IF (ASSOCIATED(ex_env%matrix_pe)) CALL dbcsr_deallocate_matrix_set(ex_env%matrix_pe)
NULLIFY (ex_env%matrix_pe)
IF (ASSOCIATED(ex_env%matrix_hz)) CALL dbcsr_deallocate_matrix_set(ex_env%matrix_hz)
NULLIFY (ex_env%matrix_hz)
IF (ASSOCIATED(ex_env%matrix_pe_admm)) CALL dbcsr_deallocate_matrix_set(ex_env%matrix_pe_admm)
NULLIFY (ex_env%matrix_pe_admm)
IF (ASSOCIATED(ex_env%matrix_px1)) CALL dbcsr_deallocate_matrix_set(ex_env%matrix_px1)
NULLIFY (ex_env%matrix_px1)
IF (ASSOCIATED(ex_env%matrix_px1_admm)) CALL dbcsr_deallocate_matrix_set(ex_env%matrix_px1_admm)
NULLIFY (ex_env%matrix_px1_admm)
IF (ASSOCIATED(ex_env%matrix_wx1)) CALL dbcsr_deallocate_matrix_set(ex_env%matrix_wx1)
NULLIFY (ex_env%matrix_wx1)
!
IF (ASSOCIATED(ex_env%vh_rspace)) THEN
CALL pw_release(ex_env%vh_rspace%pw)
DEALLOCATE (ex_env%vh_rspace)
END IF
IF (ASSOCIATED(ex_env%vxc_rspace)) THEN
DO iab = 1, SIZE(ex_env%vxc_rspace)
CALL pw_release(ex_env%vxc_rspace(iab)%pw)
END DO
DEALLOCATE (ex_env%vxc_rspace)
END IF
IF (ASSOCIATED(ex_env%vtau_rspace)) THEN
DO iab = 1, SIZE(ex_env%vtau_rspace)
CALL pw_release(ex_env%vtau_rspace(iab)%pw)
END DO
DEALLOCATE (ex_env%vtau_rspace)
END IF
IF (ASSOCIATED(ex_env%vadmm_rspace)) THEN
DO iab = 1, SIZE(ex_env%vadmm_rspace)
CALL pw_release(ex_env%vadmm_rspace(iab)%pw)
END DO
DEALLOCATE (ex_env%vadmm_rspace)
END IF
DEALLOCATE (ex_env)
END IF
END SUBROUTINE exstate_release
! **************************************************************************************************
!> \brief Allocates and intitializes exstate_env
!> \param ex_env the object to create
!> \param excited_state ...
!> \param dft_section ...
!> \par History
!> 2020.01 created
!> \author JGH
! **************************************************************************************************
SUBROUTINE exstate_create(ex_env, excited_state, dft_section)
TYPE(excited_energy_type), POINTER :: ex_env
LOGICAL, INTENT(IN) :: excited_state
TYPE(section_vals_type), POINTER :: dft_section
CHARACTER(len=*), PARAMETER :: routineN = 'exstate_create', routineP = moduleN//':'//routineN
CPASSERT(.NOT. ASSOCIATED(ex_env))
ALLOCATE (ex_env)
ex_env%evalue = 0.0_dp
NULLIFY (ex_env%evect)
IF (excited_state) THEN
CALL section_vals_val_get(dft_section, "EXCITED_STATES%STATE", i_val=ex_env%state)
CALL section_vals_val_get(dft_section, "EXCITED_STATES%XC_KERNEL_METHOD", &
i_val=ex_env%xc_kernel_method)
ELSE
ex_env%state = -1
END IF
END SUBROUTINE exstate_create
END MODULE exstates_types

1
src/hfx_admm_utils.F
View file

@ -1184,6 +1184,7 @@ CONTAINS
s_mstruct_changed=s_mstruct_changed, &
x_data=x_data)
! This should probably be the HF section from the TDDFPT XC section!
hfx_sections => section_vals_get_subs_vals(input, "DFT%XC%HF")
my_update_energy = .TRUE.

2
src/hfx_derivatives.F
View file

@ -551,7 +551,7 @@ CONTAINS
! restore as full density the HF density
! maybe in the future
IF (with_resp_density) THEN
IF (with_resp_density .AND. .NOT. my_resp_only) THEN
full_density_alpha(:, 1) = full_density_alpha(:, 1) - full_density_resp
IF (nspins == 2) THEN
full_density_beta(:, 1) = &

2
src/hfx_pair_list_methods.F
View file

@ -95,6 +95,8 @@ CONTAINS
EtaInv = list2%ZetaInv
Zeta_C = list2%zeta
Zeta_D = list2%zetb
temp_CC = 0.0_dp
temp_DD = 0.0_dp
DO i = 1, nimages1
P = list1%image_list(i)%P
R1 = list1%image_list(i)%R

8
src/input_constants.F
View file

@ -556,7 +556,8 @@ MODULE input_constants
tddfpt_spin_flip = 3
INTEGER, PARAMETER, PUBLIC :: tddfpt_lanczos = 0, &
tddfpt_davidson = 1
INTEGER, PARAMETER, PUBLIC :: tddfpt_kernel_full = 1, &
INTEGER, PARAMETER, PUBLIC :: tddfpt_kernel_none = 2, &
tddfpt_kernel_full = 1, &
tddfpt_kernel_stda = 0
INTEGER, PARAMETER, PUBLIC :: oe_none = 0, &
oe_lb = 1, &
@ -664,6 +665,11 @@ MODULE input_constants
tddfpt_dipole_length = 2, &
tddfpt_dipole_velocity = 3
! XC Kernel derivative methods for forces
INTEGER, PARAMETER, PUBLIC :: xc_kernel_method_best = 100, &
xc_kernel_method_analytic = 101, &
xc_kernel_method_numeric = 102
! Linear Response for properties
INTEGER, PARAMETER, PUBLIC :: lr_none = 0, &
lr_chemshift = 1, &

7
src/input_cp2k_dft.F
View file

@ -106,6 +106,7 @@ MODULE input_cp2k_dft
USE input_cp2k_almo, ONLY: create_almo_scf_section
USE input_cp2k_distribution, ONLY: create_distribution_section
USE input_cp2k_ec, ONLY: create_ec_section
USE input_cp2k_exstate, ONLY: create_exstate_section
USE input_cp2k_external, ONLY: create_ext_den_section,&
create_ext_pot_section,&
create_ext_vxc_section
@ -401,6 +402,10 @@ CONTAINS
CALL section_add_subsection(section, subsection)
CALL section_release(subsection)
CALL create_exstate_section(subsection)
CALL section_add_subsection(section, subsection)
CALL section_release(subsection)
CALL create_admm_section(subsection)
CALL section_add_subsection(section, subsection)
CALL section_release(subsection)
@ -4932,7 +4937,7 @@ CONTAINS
CPASSERT(.NOT. ASSOCIATED(section))
CALL section_create(section, __LOCATION__, name="tddfpt", &
description="parameters needed to set up the Time Dependent Density Functional PT", &
description="Old TDDFPT code. Use new version in CP2K_INPUT / FORCE_EVAL / PROPERTIES / TDDFPT", &
n_keywords=5, n_subsections=1, repeats=.FALSE., &
citations=(/Iannuzzi2005/))

82
src/input_cp2k_exstate.F Normal file
View file

@ -0,0 +1,82 @@
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2021 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
!> \brief Excited state input section
!> \par History
!> 01.2020 created
!> \author jgh
! **************************************************************************************************
MODULE input_cp2k_exstate
USE input_constants, ONLY: xc_kernel_method_analytic,&
xc_kernel_method_best,&
xc_kernel_method_numeric
USE input_keyword_types, ONLY: keyword_create,&
keyword_release,&
keyword_type
USE input_section_types, ONLY: section_add_keyword,&
section_create,&
section_type
USE string_utilities, ONLY: s2a
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_exstate'
PUBLIC :: create_exstate_section
CONTAINS
! **************************************************************************************************
!> \brief creates the EXCITED ENERGY section
!> \param section ...
!> \author JGH
! **************************************************************************************************
SUBROUTINE create_exstate_section(section)
TYPE(section_type), POINTER :: section
CHARACTER(len=*), PARAMETER :: routineN = 'create_exstate_section', &
routineP = moduleN//':'//routineN
TYPE(keyword_type), POINTER :: keyword
CPASSERT(.NOT. ASSOCIATED(section))
NULLIFY (keyword)
CALL section_create(section, __LOCATION__, name="EXCITED_STATES", &
description="Sets the various options for Excited State Potential Energy Calculations", &
n_keywords=1, n_subsections=0, repeats=.FALSE.)
CALL keyword_create(keyword, __LOCATION__, name="_SECTION_PARAMETERS_", &
description="Controls the activation of the excited states", &
usage="&EXCITED_STATES T", &
default_l_val=.FALSE., &
lone_keyword_l_val=.TRUE.)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
CALL keyword_create(keyword, __LOCATION__, name="STATE", &
description="Excited state to be used in calculation.", &
usage="STATE 2", &
default_i_val=1)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
CALL keyword_create(keyword, __LOCATION__, name="XC_KERNEL_METHOD", &
description="Method to evaluate XC Kernel contributions to forces", &
usage="XC_KERNEL_METHOD (BEST_AVAILABLE|ANALYTIC|NUMERIC)", &
enum_c_vals=s2a("BEST_AVAILABLE", "ANALYTIC", "NUMERIC"), &
enum_i_vals=(/xc_kernel_method_best, xc_kernel_method_analytic, xc_kernel_method_numeric/), &
default_i_val=xc_kernel_method_best)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
END SUBROUTINE create_exstate_section
END MODULE input_cp2k_exstate

10
src/input_cp2k_mp2.F
View file

@ -270,6 +270,16 @@ CONTAINS
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
CALL keyword_create( &
keyword, __LOCATION__, &
name="USE_OLD_GRADIENT_CODE", &
description="Use the original RI-MP2 gradient code.", &
usage="USE_OLD_GRADIENT_CODE T", &
lone_keyword_l_val=.TRUE., &
default_l_val=.TRUE.)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
END SUBROUTINE create_ri_mp2
! **************************************************************************************************

16
src/input_cp2k_properties_dft.F
View file

@ -37,8 +37,8 @@ MODULE input_cp2k_properties_dft
ot_precond_full_all, ot_precond_full_kinetic, ot_precond_full_single, &
ot_precond_full_single_inverse, ot_precond_none, ot_precond_s_inverse, scan_x, scan_xy, &
scan_xyz, scan_xz, scan_y, scan_yz, scan_z, tddfpt_dipole_berry, tddfpt_dipole_length, &
tddfpt_dipole_velocity, tddfpt_kernel_full, tddfpt_kernel_stda, use_mom_ref_coac, &
use_mom_ref_com, use_mom_ref_user, use_mom_ref_zero
tddfpt_dipole_velocity, tddfpt_kernel_full, tddfpt_kernel_none, tddfpt_kernel_stda, &
use_mom_ref_coac, use_mom_ref_com, use_mom_ref_user, use_mom_ref_zero
USE input_cp2k_atprop, ONLY: create_atprop_section
USE input_cp2k_dft, ONLY: create_ddapc_restraint_section,&
create_interp_section,&
@ -1191,8 +1191,8 @@ CONTAINS
CALL keyword_create(keyword, __LOCATION__, name="KERNEL", &
description="Options to compute the kernel", &
usage="KERNEL FULL", &
enum_c_vals=s2a("FULL", "sTDA"), &
enum_i_vals=(/tddfpt_kernel_full, tddfpt_kernel_stda/), &
enum_c_vals=s2a("FULL", "sTDA", "NONE"), &
enum_i_vals=(/tddfpt_kernel_full, tddfpt_kernel_stda, tddfpt_kernel_none/), &
default_i_val=tddfpt_kernel_full)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
@ -1271,6 +1271,14 @@ CONTAINS
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
CALL keyword_create(keyword, __LOCATION__, name="ADMM_KERNEL_CORRECTION_SYMMETRIC", &
description="ADMM correction functional in kernel is applied symmetrically."// &
"Original implementation is using a non-symmetric formula.", &
n_var=1, type_of_var=logical_t, &
default_l_val=.FALSE., lone_keyword_l_val=.TRUE.)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
! Strings
CALL keyword_create(keyword, __LOCATION__, name="WFN_RESTART_FILE_NAME", &
variants=(/"RESTART_FILE_NAME"/), &

6
src/input_cp2k_tb.F
View file

@ -184,6 +184,12 @@ CONTAINS
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
CALL keyword_create(keyword, __LOCATION__, name="COULOMB_LR", &
description="Use Coulomb LR (1/r) interaction terms; for debug only", &
usage="COULOMB_LR T", default_l_val=.TRUE., lone_keyword_l_val=.TRUE.)
CALL section_add_keyword(section, keyword)
CALL keyword_release(keyword)
CALL keyword_create(keyword, __LOCATION__, name="TB3_INTERACTION", &
description="Use TB3 interaction terms; for debug only", &
usage="TB3_INTERACTION T", default_l_val=.TRUE., lone_keyword_l_val=.TRUE.)

9
src/mp2_cphf.F
View file

@ -86,6 +86,7 @@ MODULE mp2_cphf
pw_p_type
USE qs_2nd_kernel_ao, ONLY: admm_projection_derivative,&
apply_2nd_order_kernel
USE qs_density_matrices, ONLY: calculate_whz_matrix
USE qs_dispersion_pairpot, ONLY: calculate_dispersion_pairpot
USE qs_dispersion_types, ONLY: qs_dispersion_type
USE qs_energy_types, ONLY: qs_energy_type
@ -116,8 +117,7 @@ MODULE mp2_cphf
qs_p_env_type
USE qs_rho_types, ONLY: qs_rho_get,&
qs_rho_type
USE response_solver, ONLY: calculate_whz_matrix,&
ks_ref_potential
USE response_solver, ONLY: ks_ref_potential
USE task_list_types, ONLY: task_list_type
USE virial_types, ONLY: virial_type,&
zero_virial
@ -498,7 +498,7 @@ CONTAINS
CALL timestop(handle)
END SUBROUTINE
END SUBROUTINE solve_z_vector_eq
! **************************************************************************************************
!> \brief Here we performe the CPHF like update using GPW,
@ -1517,7 +1517,8 @@ CONTAINS
! Finish matrix_w_mp2 with occ-occ block
DO ispin = 1, nspins
CALL calculate_whz_matrix(mos(ispin)%mo_set, p_env%kpp1(ispin)%matrix, p_env%w1(1)%matrix, 1.0_dp)
CALL calculate_whz_matrix(mos(ispin)%mo_set%mo_coeff, p_env%kpp1(ispin)%matrix, &
p_env%w1(1)%matrix, 1.0_dp)
END DO
IF (debug_forces .AND. use_virial) e_dummy = third_tr(virial%pv_virial)

2
src/mp2_setup.F
View file

@ -225,9 +225,11 @@ CONTAINS
CALL section_vals_val_get(mp2_section, "RI_SOS_MP2%SIZE_INTEG_GROUP", i_val=mp2_env%ri_laplace%integ_group_size)
CALL section_vals_val_get(mp2_section, "RI_MP2%_SECTION_PARAMETERS_", l_val=do_ri_mp2)
mp2_env%ri_mp2%use_old_grad = .FALSE.
IF (do_ri_mp2) THEN
CALL check_method(mp2_env%method)
mp2_env%method = ri_mp2_method_gpw
CALL section_vals_val_get(mp2_section, "RI_MP2%USE_OLD_GRADIENT_CODE", l_val=mp2_env%ri_mp2%use_old_grad)
END IF
CALL section_vals_val_get(mp2_section, "RI_MP2%BLOCK_SIZE", i_val=mp2_env%ri_mp2%block_size)
CALL section_vals_val_get(mp2_section, "RI_MP2%EPS_CANONICAL", r_val=mp2_env%ri_mp2%eps_canonical)

1
src/mp2_types.F
View file

@ -119,6 +119,7 @@ MODULE mp2_types
INTEGER :: block_size
REAL(dp) :: eps_canonical
LOGICAL :: free_hfx_buffer
LOGICAL :: use_old_grad
END TYPE
TYPE ri_rpa_type

2
src/optbas_fenv_manipulation.F
View file

@ -43,6 +43,7 @@ MODULE optbas_fenv_manipulation
USE optimize_basis_types, ONLY: basis_optimization_type,&
flex_basis_type
USE particle_types, ONLY: particle_type
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_energy_init, ONLY: qs_energies_init
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
@ -55,7 +56,6 @@ MODULE optbas_fenv_manipulation
set_ks_env
USE qs_matrix_pools, ONLY: mpools_get
USE qs_mo_io, ONLY: read_mo_set_from_restart
USE qs_mo_methods, ONLY: calculate_density_matrix
USE qs_mo_types, ONLY: init_mo_set,&
mo_set_p_type
USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type

4
src/qs_active_space_methods.F
View file

@ -100,6 +100,7 @@ MODULE qs_active_space_methods
eri_type_eri_element_func,&
get_irange_csr
USE qs_collocate_density, ONLY: calculate_wavefunction
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_energy_types, ONLY: qs_energy_type
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type,&
@ -114,8 +115,7 @@ MODULE qs_active_space_methods
USE qs_loc_utils, ONLY: qs_loc_control_init,&
qs_loc_env_init,&
qs_loc_init
USE qs_mo_methods, ONLY: calculate_density_matrix,&
calculate_subspace_eigenvalues
USE qs_mo_methods, ONLY: calculate_subspace_eigenvalues
USE qs_mo_types, ONLY: allocate_mo_set,&
get_mo_set,&
init_mo_set,&

4
src/qs_basis_gradient.F
View file

@ -28,6 +28,7 @@ MODULE qs_basis_gradient
USE kinds, ONLY: dp
USE particle_types, ONLY: particle_type
USE qs_core_hamiltonian, ONLY: build_core_hamiltonian_matrix
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_energy_matrix_w, ONLY: qs_energies_compute_w
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
@ -43,8 +44,7 @@ MODULE qs_basis_gradient
USE qs_ks_types, ONLY: qs_ks_env_type,&
set_ks_env
USE qs_mixing_utils, ONLY: mixing_allocate
USE qs_mo_methods, ONLY: calculate_density_matrix,&
make_basis_sm
USE qs_mo_methods, ONLY: make_basis_sm
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type
USE qs_neighbor_lists, ONLY: build_qs_neighbor_lists

542
src/qs_density_matrices.F Normal file
View file

@ -0,0 +1,542 @@
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2021 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
!> \brief collects routines that calculate density matrices
!> \note
!> first version : most routines imported
!> \author JGH (2020-01)
! **************************************************************************************************
MODULE qs_density_matrices
USE cp_blacs_env, ONLY: cp_blacs_env_type
USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
copy_fm_to_dbcsr,&
cp_dbcsr_plus_fm_fm_t,&
cp_dbcsr_sm_fm_multiply
USE cp_fm_basic_linalg, ONLY: cp_fm_column_scale,&
cp_fm_scale_and_add,&
cp_fm_symm,&
cp_fm_upper_to_full
USE cp_fm_struct, ONLY: cp_fm_struct_create,&
cp_fm_struct_release,&
cp_fm_struct_type
USE cp_fm_types, ONLY: cp_fm_create,&
cp_fm_get_info,&
cp_fm_release,&
cp_fm_to_fm,&
cp_fm_type
USE cp_gemm_interface, ONLY: cp_gemm
USE cp_para_types, ONLY: cp_para_env_type
USE dbcsr_api, ONLY: dbcsr_copy,&
dbcsr_multiply,&
dbcsr_release,&
dbcsr_scale_by_vector,&
dbcsr_set,&
dbcsr_type
USE kinds, ONLY: dp
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_type
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_density_matrices'
PUBLIC :: calculate_density_matrix
PUBLIC :: calculate_w_matrix, calculate_w_matrix_ot
PUBLIC :: calculate_wz_matrix, calculate_whz_matrix
PUBLIC :: calculate_wx_matrix, calculate_xwx_matrix
INTERFACE calculate_density_matrix
MODULE PROCEDURE calculate_dm_sparse
END INTERFACE
INTERFACE calculate_w_matrix
MODULE PROCEDURE calculate_w_matrix_1, calculate_w_matrix_roks
END INTERFACE
CONTAINS
! **************************************************************************************************
!> \brief Calculate the density matrix
!> \param mo_set ...
!> \param density_matrix ...
!> \param use_dbcsr ...
!> \param retain_sparsity ...
!> \date 06.2002
!> \par History
!> - Fractional occupied orbitals (MK)
!> \author Joost VandeVondele
!> \version 1.0
! **************************************************************************************************
SUBROUTINE calculate_dm_sparse(mo_set, density_matrix, use_dbcsr, retain_sparsity)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(dbcsr_type), POINTER :: density_matrix
LOGICAL, INTENT(IN), OPTIONAL :: use_dbcsr, retain_sparsity
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_dm_sparse', &
routineP = moduleN//':'//routineN
INTEGER :: handle
LOGICAL :: my_retain_sparsity, my_use_dbcsr
REAL(KIND=dp) :: alpha
TYPE(cp_fm_type), POINTER :: fm_tmp
TYPE(dbcsr_type) :: dbcsr_tmp
CALL timeset(routineN, handle)
my_use_dbcsr = .FALSE.
IF (PRESENT(use_dbcsr)) my_use_dbcsr = use_dbcsr
my_retain_sparsity = .TRUE.
IF (PRESENT(retain_sparsity)) my_retain_sparsity = retain_sparsity
IF (my_use_dbcsr) THEN
IF (.NOT. ASSOCIATED(mo_set%mo_coeff_b)) THEN
CPABORT("mo_coeff_b NOT ASSOCIATED")
END IF
END IF
CALL dbcsr_set(density_matrix, 0.0_dp)
IF (.NOT. mo_set%uniform_occupation) THEN ! not all orbitals 1..homo are equally occupied
IF (my_use_dbcsr) THEN
CALL dbcsr_copy(dbcsr_tmp, mo_set%mo_coeff_b)
CALL dbcsr_scale_by_vector(dbcsr_tmp, mo_set%occupation_numbers(1:mo_set%homo), &
side='right')
CALL dbcsr_multiply("N", "T", 1.0_dp, mo_set%mo_coeff_b, dbcsr_tmp, &
1.0_dp, density_matrix, retain_sparsity=my_retain_sparsity, &
last_k=mo_set%homo)
CALL dbcsr_release(dbcsr_tmp)
ELSE
NULLIFY (fm_tmp)
CALL cp_fm_create(fm_tmp, mo_set%mo_coeff%matrix_struct)
CALL cp_fm_to_fm(mo_set%mo_coeff, fm_tmp)
CALL cp_fm_column_scale(fm_tmp, mo_set%occupation_numbers(1:mo_set%homo))
alpha = 1.0_dp
CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=density_matrix, &
matrix_v=mo_set%mo_coeff, &
matrix_g=fm_tmp, &
ncol=mo_set%homo, &
alpha=alpha)
CALL cp_fm_release(fm_tmp)
ENDIF
ELSE
IF (my_use_dbcsr) THEN
CALL dbcsr_multiply("N", "T", mo_set%maxocc, mo_set%mo_coeff_b, mo_set%mo_coeff_b, &
1.0_dp, density_matrix, retain_sparsity=my_retain_sparsity, &
last_k=mo_set%homo)
ELSE
alpha = mo_set%maxocc
CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=density_matrix, &
matrix_v=mo_set%mo_coeff, &
ncol=mo_set%homo, &
alpha=alpha)
ENDIF
ENDIF
CALL timestop(handle)
END SUBROUTINE calculate_dm_sparse
! **************************************************************************************************
!> \brief Calculate the W matrix from the MO eigenvectors, MO eigenvalues,
!> and the MO occupation numbers. Only works if they are eigenstates
!> \param mo_set type containing the full matrix of the MO and the eigenvalues
!> \param w_matrix sparse matrix
!> error
!> \par History
!> Creation (03.03.03,MK)
!> Modification that computes it as a full block, several times (e.g. 20)
!> faster at the cost of some additional memory
!> \author MK
! **************************************************************************************************
SUBROUTINE calculate_w_matrix_1(mo_set, w_matrix)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(dbcsr_type), POINTER :: w_matrix
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_w_matrix_1', &
routineP = moduleN//':'//routineN
INTEGER :: handle, imo
REAL(KIND=dp), DIMENSION(:), POINTER :: eigocc
TYPE(cp_fm_type), POINTER :: weighted_vectors
CALL timeset(routineN, handle)
NULLIFY (weighted_vectors)
CALL dbcsr_set(w_matrix, 0.0_dp)
CALL cp_fm_create(weighted_vectors, mo_set%mo_coeff%matrix_struct, "weighted_vectors")
CALL cp_fm_to_fm(mo_set%mo_coeff, weighted_vectors)
! scale every column with the occupation
ALLOCATE (eigocc(mo_set%homo))
DO imo = 1, mo_set%homo
eigocc(imo) = mo_set%eigenvalues(imo)*mo_set%occupation_numbers(imo)
ENDDO
CALL cp_fm_column_scale(weighted_vectors, eigocc)
DEALLOCATE (eigocc)
CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=w_matrix, &
matrix_v=mo_set%mo_coeff, &
matrix_g=weighted_vectors, &
ncol=mo_set%homo)
CALL cp_fm_release(weighted_vectors)
CALL timestop(handle)
END SUBROUTINE calculate_w_matrix_1
! **************************************************************************************************
!> \brief Calculate the W matrix from the MO coefs, MO derivs
!> could overwrite the mo_derivs for increased memory efficiency
!> \param mo_set type containing the full matrix of the MO coefs
!> mo_deriv:
!> \param mo_deriv ...
!> \param w_matrix sparse matrix
!> \param s_matrix sparse matrix for the overlap
!> error
!> \par History
!> Creation (JV)
!> \author MK
! **************************************************************************************************
SUBROUTINE calculate_w_matrix_ot(mo_set, mo_deriv, w_matrix, s_matrix)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(dbcsr_type), POINTER :: mo_deriv, w_matrix, s_matrix
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_w_matrix_ot', &
routineP = moduleN//':'//routineN
LOGICAL, PARAMETER :: check_gradient = .FALSE., &
do_symm = .FALSE.
INTEGER :: handle, ncol_block, ncol_global, &
nrow_block, nrow_global
REAL(KIND=dp), DIMENSION(:), POINTER :: occupation_numbers, scaling_factor
TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
TYPE(cp_fm_type), POINTER :: gradient, h_block, h_block_t, &
weighted_vectors
CALL timeset(routineN, handle)
NULLIFY (weighted_vectors, h_block, fm_struct_tmp)
CALL cp_fm_get_info(matrix=mo_set%mo_coeff, &
ncol_global=ncol_global, &
nrow_global=nrow_global, &
nrow_block=nrow_block, &
ncol_block=ncol_block)
CALL cp_fm_create(weighted_vectors, mo_set%mo_coeff%matrix_struct, "weighted_vectors")
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol_global, ncol_global=ncol_global, &
para_env=mo_set%mo_coeff%matrix_struct%para_env, &
context=mo_set%mo_coeff%matrix_struct%context)
CALL cp_fm_create(h_block, fm_struct_tmp, name="h block")
IF (do_symm) CALL cp_fm_create(h_block_t, fm_struct_tmp, name="h block t")
CALL cp_fm_struct_release(fm_struct_tmp)
CALL get_mo_set(mo_set=mo_set, occupation_numbers=occupation_numbers)
ALLOCATE (scaling_factor(SIZE(occupation_numbers)))
scaling_factor = 2.0_dp*occupation_numbers
CALL copy_dbcsr_to_fm(mo_deriv, weighted_vectors)
CALL cp_fm_column_scale(weighted_vectors, scaling_factor)
DEALLOCATE (scaling_factor)
! the convention seems to require the half here, the factor of two is presumably taken care of
! internally in qs_core_hamiltonian
CALL cp_gemm('T', 'N', ncol_global, ncol_global, nrow_global, 0.5_dp, &
mo_set%mo_coeff, weighted_vectors, 0.0_dp, h_block)
IF (do_symm) THEN
! at the minimum things are anyway symmetric, but numerically it might not be the case
! needs some investigation to find out if using this is better
CALL cp_fm_transpose(h_block, h_block_t)
CALL cp_fm_scale_and_add(0.5_dp, h_block, 0.5_dp, h_block_t)
ENDIF
! this could overwrite the mo_derivs to save the weighted_vectors
CALL cp_gemm('N', 'N', nrow_global, ncol_global, ncol_global, 1.0_dp, &
mo_set%mo_coeff, h_block, 0.0_dp, weighted_vectors)
CALL dbcsr_set(w_matrix, 0.0_dp)
CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=w_matrix, &
matrix_v=mo_set%mo_coeff, &
matrix_g=weighted_vectors, &
ncol=mo_set%homo)
IF (check_gradient) THEN
CALL cp_fm_create(gradient, mo_set%mo_coeff%matrix_struct, "gradient")
CALL cp_dbcsr_sm_fm_multiply(s_matrix, weighted_vectors, &
gradient, ncol_global)
ALLOCATE (scaling_factor(SIZE(occupation_numbers)))
scaling_factor = 2.0_dp*occupation_numbers
CALL copy_dbcsr_to_fm(mo_deriv, weighted_vectors)
CALL cp_fm_column_scale(weighted_vectors, scaling_factor)
DEALLOCATE (scaling_factor)
WRITE (*, *) " maxabs difference ", MAXVAL(ABS(weighted_vectors%local_data - 2.0_dp*gradient%local_data))
CALL cp_fm_release(gradient)
ENDIF
IF (do_symm) CALL cp_fm_release(h_block_t)
CALL cp_fm_release(weighted_vectors)
CALL cp_fm_release(h_block)
CALL timestop(handle)
END SUBROUTINE calculate_w_matrix_ot
! **************************************************************************************************
!> \brief Calculate the energy-weighted density matrix W if ROKS is active.
!> The W matrix is returned in matrix_w.
!> \param mo_set ...
!> \param matrix_ks ...
!> \param matrix_p ...
!> \param matrix_w ...
!> \author 04.05.06,MK
! **************************************************************************************************
SUBROUTINE calculate_w_matrix_roks(mo_set, matrix_ks, matrix_p, matrix_w)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(dbcsr_type), POINTER :: matrix_ks, matrix_p, matrix_w
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_w_matrix_roks', &
routineP = moduleN//':'//routineN
INTEGER :: handle, nao
TYPE(cp_blacs_env_type), POINTER :: context
TYPE(cp_fm_struct_type), POINTER :: fm_struct
TYPE(cp_fm_type), POINTER :: c, ks, p, work
TYPE(cp_para_env_type), POINTER :: para_env
CALL timeset(routineN, handle)
NULLIFY (c)
NULLIFY (context)
NULLIFY (fm_struct)
NULLIFY (ks)
NULLIFY (p)
NULLIFY (para_env)
NULLIFY (work)
CALL get_mo_set(mo_set=mo_set, mo_coeff=c)
CALL cp_fm_get_info(c, context=context, nrow_global=nao, para_env=para_env)
CALL cp_fm_struct_create(fm_struct, context=context, nrow_global=nao, &
ncol_global=nao, para_env=para_env)
CALL cp_fm_create(ks, fm_struct, name="Kohn-Sham matrix")
CALL cp_fm_create(p, fm_struct, name="Density matrix")
CALL cp_fm_create(work, fm_struct, name="Work matrix")
CALL cp_fm_struct_release(fm_struct)
CALL copy_dbcsr_to_fm(matrix_ks, ks)
CALL copy_dbcsr_to_fm(matrix_p, p)
CALL cp_fm_upper_to_full(p, work)
CALL cp_fm_symm("L", "U", nao, nao, 1.0_dp, ks, p, 0.0_dp, work)
CALL cp_gemm("T", "N", nao, nao, nao, 1.0_dp, p, work, 0.0_dp, ks)
CALL dbcsr_set(matrix_w, 0.0_dp)
CALL copy_fm_to_dbcsr(ks, matrix_w, keep_sparsity=.TRUE.)
CALL cp_fm_release(work)
CALL cp_fm_release(p)
CALL cp_fm_release(ks)
CALL timestop(handle)
END SUBROUTINE calculate_w_matrix_roks
! **************************************************************************************************
!> \brief Calculate the response W matrix from the MO eigenvectors, MO eigenvalues,
!> and the MO occupation numbers. Only works if they are eigenstates
!> \param mo_set type containing the full matrix of the MO and the eigenvalues
!> \param psi1 response orbitals
!> \param ks_matrix Kohn-Sham sparse matrix
!> \param w_matrix sparse matrix
!> \par History
!> adapted from calculate_w_matrix_1
!> \author JGH
! **************************************************************************************************
SUBROUTINE calculate_wz_matrix(mo_set, psi1, ks_matrix, w_matrix)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(cp_fm_type), POINTER :: psi1
TYPE(dbcsr_type), POINTER :: ks_matrix, w_matrix
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_wz_matrix', &
routineP = moduleN//':'//routineN
INTEGER :: handle, ncol, nrow
TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
TYPE(cp_fm_type), POINTER :: ksmat, scrv
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix=mo_set%mo_coeff, ncol_global=ncol, nrow_global=nrow)
CALL cp_fm_create(scrv, mo_set%mo_coeff%matrix_struct, "scr vectors")
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol, ncol_global=ncol, &
para_env=mo_set%mo_coeff%matrix_struct%para_env, &
context=mo_set%mo_coeff%matrix_struct%context)
CALL cp_fm_create(ksmat, fm_struct_tmp, name="KS")
CALL cp_fm_struct_release(fm_struct_tmp)
CALL cp_dbcsr_sm_fm_multiply(ks_matrix, mo_set%mo_coeff, scrv, ncol)
CALL cp_gemm("T", "N", ncol, ncol, nrow, 1.0_dp, mo_set%mo_coeff, scrv, 0.0_dp, ksmat)
CALL cp_gemm("N", "N", nrow, ncol, ncol, 1.0_dp, mo_set%mo_coeff, ksmat, 0.0_dp, scrv)
CALL dbcsr_set(w_matrix, 0.0_dp)
CALL cp_dbcsr_plus_fm_fm_t(w_matrix, matrix_v=scrv, matrix_g=psi1, &
ncol=mo_set%homo, alpha=0.5_dp)
CALL cp_dbcsr_plus_fm_fm_t(w_matrix, matrix_v=psi1, matrix_g=scrv, &
ncol=mo_set%homo, alpha=0.5_dp)
CALL cp_fm_release(scrv)
CALL cp_fm_release(ksmat)
CALL timestop(handle)
END SUBROUTINE calculate_wz_matrix
! **************************************************************************************************
!> \brief Calculate the Wz matrix from the MO eigenvectors, MO eigenvalues,
!> and the MO occupation numbers. Only works if they are eigenstates
!> \param c0vec ...
!> \param hzm ...
!> \param w_matrix sparse matrix
!> \param focc ...
!> \par History
!> adapted from calculate_w_matrix_1
!> \author JGH
! **************************************************************************************************
SUBROUTINE calculate_whz_matrix(c0vec, hzm, w_matrix, focc)
TYPE(cp_fm_type), POINTER :: c0vec
TYPE(dbcsr_type), POINTER :: hzm, w_matrix
REAL(KIND=dp), INTENT(IN) :: focc
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_whz_matrix', &
routineP = moduleN//':'//routineN
INTEGER :: handle, nao, norb
REAL(KIND=dp) :: falpha
TYPE(cp_fm_struct_type), POINTER :: fm_struct, fm_struct_mat
TYPE(cp_fm_type), POINTER :: chcmat, hcvec
CALL timeset(routineN, handle)
falpha = focc
CALL cp_fm_create(hcvec, c0vec%matrix_struct, "hcvec")
CALL cp_fm_get_info(hcvec, matrix_struct=fm_struct, nrow_global=nao, ncol_global=norb)
CALL cp_fm_struct_create(fm_struct_mat, context=fm_struct%context, nrow_global=norb, &
ncol_global=norb, para_env=fm_struct%para_env)
CALL cp_fm_create(chcmat, fm_struct_mat)
CALL cp_fm_struct_release(fm_struct_mat)
CALL cp_dbcsr_sm_fm_multiply(hzm, c0vec, hcvec, norb)
CALL cp_gemm("T", "N", norb, norb, nao, 1.0_dp, c0vec, hcvec, 0.0_dp, chcmat)
CALL cp_gemm("N", "N", nao, norb, norb, 1.0_dp, c0vec, chcmat, 0.0_dp, hcvec)
CALL cp_dbcsr_plus_fm_fm_t(w_matrix, matrix_v=hcvec, matrix_g=c0vec, ncol=norb, alpha=falpha)
CALL cp_fm_release(hcvec)
CALL cp_fm_release(chcmat)
CALL timestop(handle)
END SUBROUTINE calculate_whz_matrix
! **************************************************************************************************
!> \brief Calculate the excited state W matrix from the MO eigenvectors, KS matrix
!> \param mos_occ ...
!> \param xvec ...
!> \param ks_matrix ...
!> \param w_matrix ...
!> \par History
!> adapted from calculate_wz_matrix
!> \author JGH
! **************************************************************************************************
SUBROUTINE calculate_wx_matrix(mos_occ, xvec, ks_matrix, w_matrix)
TYPE(cp_fm_type), POINTER :: mos_occ, xvec
TYPE(dbcsr_type), POINTER :: ks_matrix, w_matrix
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_wx_matrix', &
routineP = moduleN//':'//routineN
INTEGER :: handle, ncol, nrow
TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
TYPE(cp_fm_type), POINTER :: ksmat, scrv
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix=mos_occ, ncol_global=ncol, nrow_global=nrow)
CALL cp_fm_create(scrv, mos_occ%matrix_struct, "scr vectors")
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol, ncol_global=ncol, &
para_env=mos_occ%matrix_struct%para_env, &
context=mos_occ%matrix_struct%context)
CALL cp_fm_create(ksmat, fm_struct_tmp, name="KS")
CALL cp_fm_struct_release(fm_struct_tmp)
CALL cp_dbcsr_sm_fm_multiply(ks_matrix, mos_occ, scrv, ncol)
CALL cp_gemm("T", "N", ncol, ncol, nrow, 1.0_dp, mos_occ, scrv, 0.0_dp, ksmat)
CALL cp_gemm("N", "N", nrow, ncol, ncol, 1.0_dp, xvec, ksmat, 0.0_dp, scrv)
CALL cp_dbcsr_plus_fm_fm_t(w_matrix, matrix_v=scrv, matrix_g=xvec, ncol=ncol, alpha=0.5_dp)
CALL cp_dbcsr_plus_fm_fm_t(w_matrix, matrix_v=xvec, matrix_g=scrv, ncol=ncol, alpha=0.5_dp)
CALL cp_fm_release(scrv)
CALL cp_fm_release(ksmat)
CALL timestop(handle)
END SUBROUTINE calculate_wx_matrix
! **************************************************************************************************
!> \brief Calculate the excited state W matrix from the MO eigenvectors, KS matrix
!> \param mos_occ ...
!> \param xvec ...
!> \param s_matrix ...
!> \param ks_matrix ...
!> \param w_matrix ...
!> \param eval ...
!> \par History
!> adapted from calculate_wz_matrix
!> \author JGH
! **************************************************************************************************
SUBROUTINE calculate_xwx_matrix(mos_occ, xvec, s_matrix, ks_matrix, w_matrix, eval)
TYPE(cp_fm_type), POINTER :: mos_occ, xvec
TYPE(dbcsr_type), POINTER :: s_matrix, ks_matrix, w_matrix
REAL(KIND=dp), INTENT(IN) :: eval
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_xwx_matrix', &
routineP = moduleN//':'//routineN
INTEGER :: handle, ncol, nrow
TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
TYPE(cp_fm_type), POINTER :: scrv, xsxmat
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix=mos_occ, ncol_global=ncol, nrow_global=nrow)
CALL cp_fm_create(scrv, mos_occ%matrix_struct, "scr vectors")
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol, ncol_global=ncol, &
para_env=mos_occ%matrix_struct%para_env, &
context=mos_occ%matrix_struct%context)
CALL cp_fm_create(xsxmat, fm_struct_tmp, name="XSX")
CALL cp_fm_struct_release(fm_struct_tmp)
CALL cp_dbcsr_sm_fm_multiply(ks_matrix, xvec, scrv, ncol, 1.0_dp, 0.0_dp)
CALL cp_dbcsr_sm_fm_multiply(s_matrix, xvec, scrv, ncol, eval, -1.0_dp)
CALL cp_gemm("T", "N", ncol, ncol, nrow, 1.0_dp, xvec, scrv, 0.0_dp, xsxmat)
CALL cp_gemm("N", "N", nrow, ncol, ncol, 1.0_dp, mos_occ, xsxmat, 0.0_dp, scrv)
CALL cp_dbcsr_plus_fm_fm_t(w_matrix, matrix_v=scrv, matrix_g=mos_occ, ncol=ncol, alpha=0.5_dp)
CALL cp_dbcsr_plus_fm_fm_t(w_matrix, matrix_v=mos_occ, matrix_g=scrv, ncol=ncol, alpha=0.5_dp)
CALL cp_fm_release(scrv)
CALL cp_fm_release(xsxmat)
CALL timestop(handle)
END SUBROUTINE calculate_xwx_matrix
END MODULE qs_density_matrices

4
src/qs_dispersion_pairpot.F
View file

@ -1273,9 +1273,7 @@ CONTAINS
atener => atprop%atevdw
END IF
atstress = atprop%stress
IF (atstress) THEN
atstr => atprop%atstress
END IF
atstr => atprop%atstress
IF (unit_nr > 0) THEN
WRITE (unit_nr, *)

5
src/qs_energy.F
View file

@ -16,6 +16,7 @@ MODULE qs_energy
USE cp_control_types, ONLY: dft_control_type
USE dm_ls_scf, ONLY: ls_scf
USE energy_corrections, ONLY: energy_correction
USE excited_states, ONLY: excited_state_energy
USE lri_environment_methods, ONLY: lri_print_stat
USE qs_energy_init, ONLY: qs_energies_init
USE qs_energy_types, ONLY: qs_energy_type
@ -112,7 +113,9 @@ CONTAINS
CALL energy_correction(qs_env, ec_init=.TRUE., calculate_forces=.FALSE.)
END IF
CALL qs_energies_properties(qs_env)
CALL qs_energies_properties(qs_env, calc_forces)
CALL excited_state_energy(qs_env, calculate_forces=.FALSE.)
IF (dft_control%qs_control%lrigpw) THEN
CALL lri_print_stat(qs_env)

4
src/qs_energy_matrix_w.F
View file

@ -26,10 +26,10 @@ MODULE qs_energy_matrix_w
USE kpoint_methods, ONLY: kpoint_density_matrices,&
kpoint_density_transform
USE kpoint_types, ONLY: kpoint_type
USE qs_density_matrices, ONLY: calculate_w_matrix,&
calculate_w_matrix_ot
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
USE qs_ks_methods, ONLY: calculate_w_matrix,&
calculate_w_matrix_ot
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type,&
mo_set_type

3
src/qs_energy_types.F
View file

@ -65,6 +65,8 @@ MODULE qs_energy_types
! non-scf orbital(density) corrections
! for example, almo delocalization corrction
singles_corr, &
! excitation energy
excited_state, &
total, &
tot_old, &
kinetic, & !total kinetic energy [rk]
@ -187,6 +189,7 @@ CONTAINS
qs_energy%efermi = 0.0_dp
qs_energy%kinetic = 0.0_dp
qs_energy%surf_dipole = 0.0_dp
qs_energy%excited_state = 0.0_dp
qs_energy%total = 0.0_dp
qs_energy%singles_corr = 0.0_dp
qs_energy%nonscf_correction = 0.0_dp

12
src/qs_energy_utils.F
View file

@ -40,13 +40,13 @@ MODULE qs_energy_utils
USE mp2, ONLY: mp2_main
USE pw_env_types, ONLY: pw_env_type
USE pw_types, ONLY: pw_p_type
USE qs_density_matrices, ONLY: calculate_w_matrix,&
calculate_w_matrix_ot
USE qs_energy_types, ONLY: qs_energy_type
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
USE qs_integrate_potential, ONLY: integrate_v_core_rspace
USE qs_ks_methods, ONLY: calculate_w_matrix,&
calculate_w_matrix_ot,&
qs_ks_update_qs_env
USE qs_ks_methods, ONLY: qs_ks_update_qs_env
USE qs_linres_module, ONLY: linres_calculation_low
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type,&
@ -202,12 +202,14 @@ CONTAINS
!> \brief Refactoring of qs_energies_scf. Moves computation of properties
!> into separate subroutine
!> \param qs_env ...
!> \param calc_forces ...
!> \par History
!> 05.2013 created [Florian Schiffmann]
! **************************************************************************************************
SUBROUTINE qs_energies_properties(qs_env)
SUBROUTINE qs_energies_properties(qs_env, calc_forces)
TYPE(qs_environment_type), POINTER :: qs_env
LOGICAL, INTENT(IN) :: calc_forces
CHARACTER(len=*), PARAMETER :: routineN = 'qs_energies_properties'
@ -298,7 +300,7 @@ CONTAINS
END IF
IF (dft_control%tddfpt2_control%enabled) THEN
CALL tddfpt(qs_env)
CALL tddfpt(qs_env, calc_forces)
END IF
! tip scan

21
src/qs_environment.F
View file

@ -67,6 +67,7 @@ MODULE qs_environment
distribution_1d_type
USE distribution_methods, ONLY: distribute_molecules_1d
USE dm_ls_scf_create, ONLY: ls_scf_create
USE ec_env_types, ONLY: energy_correction_type
USE ec_environment, ONLY: ec_env_create
USE et_coupling_types, ONLY: et_coupling_create
USE ewald_environment_types, ONLY: ewald_env_create,&
@ -80,6 +81,8 @@ MODULE qs_environment
USE ewald_pw_types, ONLY: ewald_pw_create,&
ewald_pw_release,&
ewald_pw_type
USE exstates_types, ONLY: excited_energy_type,&
exstate_create
USE external_potential_types, ONLY: get_potential,&
init_potential,&
set_potential
@ -264,6 +267,8 @@ CONTAINS
TYPE(cell_type), POINTER :: my_cell, my_cell_ref
TYPE(cp_blacs_env_type), POINTER :: blacs_env
TYPE(dft_control_type), POINTER :: dft_control
TYPE(energy_correction_type), POINTER :: ec_env
TYPE(excited_energy_type), POINTER :: exstate_env
TYPE(kpoint_type), POINTER :: kpoints
TYPE(lri_environment_type), POINTER :: lri_env
TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
@ -440,6 +445,16 @@ CONTAINS
CALL kg_env_create(qs_env, qs_env%kg_env, qs_kind_set, qs_env%input)
END IF
dft_section => section_vals_get_subs_vals(qs_env%input, "DFT")
CALL section_vals_val_get(dft_section, "ENERGY_CORRECTION%_SECTION_PARAMETERS_", &
l_val=qs_env%energy_correction)
dft_section => section_vals_get_subs_vals(qs_env%input, "DFT")
CALL section_vals_val_get(dft_section, "EXCITED_STATES%_SECTION_PARAMETERS_", &
l_val=qs_env%excited_state)
NULLIFY (exstate_env)
CALL exstate_create(exstate_env, qs_env%excited_state, dft_section)
CALL set_qs_env(qs_env, exstate_env=exstate_env)
et_coupling_section => section_vals_get_subs_vals(qs_env%input, &
"PROPERTIES%ET_COUPLING")
CALL section_vals_get(et_coupling_section, explicit=do_et)
@ -455,13 +470,13 @@ CONTAINS
CALL ls_scf_create(qs_env)
ENDIF
NULLIFY (ec_env)
dft_section => section_vals_get_subs_vals(qs_env%input, "DFT")
CALL section_vals_val_get(dft_section, "ENERGY_CORRECTION%_SECTION_PARAMETERS_", &
l_val=qs_env%energy_correction)
ec_section => section_vals_get_subs_vals(qs_env%input, "DFT%ENERGY_CORRECTION")
IF (qs_env%energy_correction) THEN
CALL ec_env_create(qs_env, qs_env%ec_env, dft_section, ec_section)
END IF
CALL ec_env_create(qs_env, ec_env, dft_section, ec_section)
CALL set_qs_env(qs_env, ec_env=ec_env)
IF (dft_control%qs_control%do_almo_scf) THEN
CALL almo_scf_env_create(qs_env)

20
src/qs_environment_types.F
View file

@ -51,6 +51,8 @@ MODULE qs_environment_types
USE ewald_pw_types, ONLY: ewald_pw_release,&
ewald_pw_retain,&
ewald_pw_type
USE exstates_types, ONLY: excited_energy_type,&
exstate_release
USE fist_nonbond_env_types, ONLY: fist_nonbond_env_release,&
fist_nonbond_env_type
USE global_types, ONLY: global_environment_type
@ -285,6 +287,9 @@ MODULE qs_environment_types
TYPE(lri_density_type), POINTER :: lri_density
! Energy correction
TYPE(energy_correction_type), POINTER :: ec_env
! Excited States
LOGICAL :: excited_state
TYPE(excited_energy_type), POINTER :: exstate_env
! Empirical dispersion
TYPE(qs_dispersion_type), POINTER :: dispersion_env
! Empirical geometrical BSSE correction
@ -472,6 +477,7 @@ CONTAINS
!> \param admm_dm ...
!> \param lri_env ...
!> \param lri_density ...
!> \param exstate_env ...
!> \param ec_env ...
!> \param dispersion_env ...
!> \param gcp_env ...
@ -527,7 +533,8 @@ CONTAINS
neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, &
outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, &
se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, admm_dm, &
lri_env, lri_density, ec_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, &
lri_env, lri_density, exstate_env, ec_env, dispersion_env, gcp_env, vee, &
rho_external, external_vxc, mask, &
mp2_env, kg_env, WannierCentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, &
s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, &
gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, rhs)
@ -641,6 +648,7 @@ CONTAINS
TYPE(admm_dm_type), OPTIONAL, POINTER :: admm_dm
TYPE(lri_environment_type), OPTIONAL, POINTER :: lri_env
TYPE(lri_density_type), OPTIONAL, POINTER :: lri_density
TYPE(excited_energy_type), OPTIONAL, POINTER :: exstate_env
TYPE(energy_correction_type), OPTIONAL, POINTER :: ec_env
TYPE(qs_dispersion_type), OPTIONAL, POINTER :: dispersion_env
TYPE(qs_gcp_type), OPTIONAL, POINTER :: gcp_env
@ -718,6 +726,7 @@ CONTAINS
IF (PRESENT(lri_env)) lri_env => qs_env%lri_env
IF (PRESENT(lri_density)) lri_density => qs_env%lri_density
IF (PRESENT(ec_env)) ec_env => qs_env%ec_env
IF (PRESENT(exstate_env)) exstate_env => qs_env%exstate_env
IF (PRESENT(dispersion_env)) dispersion_env => qs_env%dispersion_env
IF (PRESENT(gcp_env)) gcp_env => qs_env%gcp_env
IF (PRESENT(run_rtp)) run_rtp = qs_env%run_rtp
@ -939,6 +948,7 @@ CONTAINS
NULLIFY (qs_env%efield)
NULLIFY (qs_env%lri_env)
NULLIFY (qs_env%ec_env)
NULLIFY (qs_env%exstate_env)
NULLIFY (qs_env%lri_density)
NULLIFY (qs_env%gcp_env)
NULLIFY (qs_env%rtp)
@ -1048,6 +1058,7 @@ CONTAINS
!> \param transport_env ...
!> \param lri_env ...
!> \param lri_density ...
!> \param exstate_env ...
!> \param ec_env ...
!> \param dispersion_env ...
!> \param gcp_env ...
@ -1080,7 +1091,7 @@ CONTAINS
linres_control, xas_env, cp_ddapc_env, cp_ddapc_ewald, &
outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, &
se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, ls_scf_env, &
do_transport, transport_env, lri_env, lri_density, ec_env, dispersion_env, &
do_transport, transport_env, lri_env, lri_density, exstate_env, ec_env, dispersion_env, &
gcp_env, mp2_env, kg_env, force, &
kpoints, WannierCentres, almo_scf_env, gradient_history, variable_history, embed_pot, &
spin_embed_pot, polar_env, mos_last_converged, rhs)
@ -1142,6 +1153,7 @@ CONTAINS
TYPE(transport_env_type), OPTIONAL, POINTER :: transport_env
TYPE(lri_environment_type), OPTIONAL, POINTER :: lri_env
TYPE(lri_density_type), OPTIONAL, POINTER :: lri_density
TYPE(excited_energy_type), OPTIONAL, POINTER :: exstate_env
TYPE(energy_correction_type), OPTIONAL, POINTER :: ec_env
TYPE(qs_dispersion_type), OPTIONAL, POINTER :: dispersion_env
TYPE(qs_gcp_type), OPTIONAL, POINTER :: gcp_env
@ -1331,6 +1343,7 @@ CONTAINS
IF (PRESENT(lri_env)) qs_env%lri_env => lri_env
IF (PRESENT(lri_density)) qs_env%lri_density => lri_density
IF (PRESENT(ec_env)) qs_env%ec_env => ec_env
IF (PRESENT(exstate_env)) qs_env%exstate_env => exstate_env
IF (PRESENT(dispersion_env)) qs_env%dispersion_env => dispersion_env
IF (PRESENT(gcp_env)) qs_env%gcp_env => gcp_env
IF (PRESENT(WannierCentres)) qs_env%WannierCentres => WannierCentres
@ -1560,6 +1573,9 @@ CONTAINS
IF (ASSOCIATED(qs_env%ec_env)) THEN
CALL ec_env_release(qs_env%ec_env)
END IF
IF (ASSOCIATED(qs_env%exstate_env)) THEN
CALL exstate_release(qs_env%exstate_env)
END IF
IF (ASSOCIATED(qs_env%mp2_env)) THEN
CALL mp2_env_release(qs_env%mp2_env)
END IF

2
src/qs_fb_env_methods.F
View file

@ -62,6 +62,7 @@ MODULE qs_fb_env_methods
USE orbital_pointers, ONLY: nco,&
ncoset
USE particle_types, ONLY: particle_type
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_diis, ONLY: qs_diis_b_step
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
@ -89,7 +90,6 @@ MODULE qs_fb_env_methods
mpools_rebuild_fm_pools,&
mpools_release,&
qs_matrix_pools_type
USE qs_mo_methods, ONLY: calculate_density_matrix
USE qs_mo_occupation, ONLY: set_mo_occupation
USE qs_mo_types, ONLY: allocate_mo_set,&
deallocate_mo_set,&

10
src/qs_force.F
View file

@ -35,6 +35,7 @@ MODULE qs_force
USE ec_env_types, ONLY: energy_correction_type
USE efield_utils, ONLY: calculate_ecore_efield
USE energy_corrections, ONLY: energy_correction
USE excited_states, ONLY: excited_state_energy
USE input_constants, ONLY: do_admm_purify_none
USE input_section_types, ONLY: section_vals_get_subs_vals,&
section_vals_type,&
@ -299,7 +300,7 @@ CONTAINS
CALL build_xtb_matrices(qs_env=qs_env, para_env=para_env, &
calculate_forces=.TRUE.)
ELSEIF (perform_ec) THEN
CALL energy_correction(qs_env, ec_init=.FALSE., calculate_forces=.TRUE.)
!
ELSE
! Dispersion energy and forces are calculated in qs_energy?
CALL build_core_hamiltonian_matrix(qs_env=qs_env, calculate_forces=.TRUE.)
@ -380,6 +381,13 @@ CONTAINS
CALL update_mp2_forces(qs_env)
END IF
IF (perform_ec) THEN
CALL energy_correction(qs_env, ec_init=.FALSE., calculate_forces=.TRUE.)
END IF
! Excited state forces
CALL excited_state_energy(qs_env, calculate_forces=.TRUE.)
! replicate forces (get current pointer)
NULLIFY (force)
CALL get_qs_env(qs_env=qs_env, force=force)

84
src/qs_force_types.F
View file

@ -12,9 +12,11 @@
! **************************************************************************************************
MODULE qs_force_types
!USE cp_control_types, ONLY: qs_control_type
USE atomic_kind_types, ONLY: atomic_kind_type,&
get_atomic_kind
USE cp_log_handling, ONLY: cp_get_default_logger,&
cp_logger_get_default_io_unit,&
cp_logger_type
USE cp_para_types, ONLY: cp_para_env_type
USE kinds, ONLY: dp
USE message_passing, ONLY: mp_sum
@ -61,7 +63,8 @@ MODULE qs_force_types
get_qs_force, &
put_qs_force, &
total_qs_force, &
zero_qs_force
zero_qs_force, &
write_forces_debug
CONTAINS
@ -577,4 +580,81 @@ CONTAINS
END SUBROUTINE total_qs_force
! **************************************************************************************************
!> \brief Write a Quickstep force data for 1 atom
!> \param qs_force ...
!> \param ikind ...
!> \param iatom ...
!> \param iunit ...
!> \date 05.06.2002
!> \author MK/JGH
!> \version 1.0
! **************************************************************************************************
SUBROUTINE write_forces_debug(qs_force, ikind, iatom, iunit)
TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
INTEGER, INTENT(IN), OPTIONAL :: ikind, iatom, iunit
CHARACTER(LEN=35) :: fmtstr2
CHARACTER(LEN=48) :: fmtstr1
INTEGER :: iounit, jatom, jkind
REAL(KIND=dp), DIMENSION(3) :: total
TYPE(cp_logger_type), POINTER :: logger
IF (PRESENT(iunit)) THEN
iounit = iunit
ELSE
NULLIFY (logger)
logger => cp_get_default_logger()
iounit = cp_logger_get_default_io_unit(logger)
END IF
IF (PRESENT(ikind)) THEN
jkind = ikind
ELSE
jkind = 1
END IF
IF (PRESENT(iatom)) THEN
jatom = iatom
ELSE
jatom = 1
END IF
IF (iounit > 0) THEN
fmtstr1 = "(/,T2,A,/,T3,A,T11,A,T23,A,T40,A1,2(17X,A1))"
fmtstr2 = "((T2,I5,4X,I4,T18,A,T34,3F18.12))"
WRITE (UNIT=iounit, FMT=fmtstr1) &
"FORCES [a.u.]", "Atom", "Kind", "Component", "X", "Y", "Z"
total(1:3) = qs_force(jkind)%overlap(1:3, jatom) &
+ qs_force(jkind)%overlap_admm(1:3, jatom) &
+ qs_force(jkind)%kinetic(1:3, jatom) &
+ qs_force(jkind)%gth_ppl(1:3, jatom) &
+ qs_force(jkind)%gth_ppnl(1:3, jatom) &
+ qs_force(jkind)%core_overlap(1:3, jatom) &
+ qs_force(jkind)%rho_core(1:3, jatom) &
+ qs_force(jkind)%rho_elec(1:3, jatom) &
+ qs_force(jkind)%dispersion(1:3, jatom) &
+ qs_force(jkind)%fock_4c(1:3, jatom) &
+ qs_force(jkind)%mp2_non_sep(1:3, jatom)
WRITE (UNIT=iounit, FMT=fmtstr2) &
jatom, jkind, " overlap", qs_force(jkind)%overlap(1:3, jatom), &
jatom, jkind, " overlap_admm", qs_force(jkind)%overlap_admm(1:3, jatom), &
jatom, jkind, " kinetic", qs_force(jkind)%kinetic(1:3, jatom), &
jatom, jkind, " gth_ppl", qs_force(jkind)%gth_ppl(1:3, jatom), &
jatom, jkind, " gth_ppnl", qs_force(jkind)%gth_ppnl(1:3, jatom), &
jatom, jkind, " core_overlap", qs_force(jkind)%core_overlap(1:3, jatom), &
jatom, jkind, " rho_core", qs_force(jkind)%rho_core(1:3, jatom), &
jatom, jkind, " rho_elec", qs_force(jkind)%rho_elec(1:3, jatom), &
jatom, jkind, " dispersion", qs_force(jkind)%dispersion(1:3, jatom), &
jatom, jkind, " fock_4c", qs_force(jkind)%fock_4c(1:3, jatom), &
jatom, jkind, " mp2_non_sep", qs_force(jkind)%mp2_non_sep(1:3, jatom), &
jatom, jkind, " total", total(1:3)
END IF
END SUBROUTINE write_forces_debug
END MODULE qs_force_types

428
src/qs_fxc.F Normal file
View file

@ -0,0 +1,428 @@
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2021 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
!> \brief https://en.wikipedia.org/wiki/Finite_difference_coefficient
!---------------------------------------------------------------------------------------------------
!Derivative Accuracy 4 3 2 1 0 1 2 3 4
!---------------------------------------------------------------------------------------------------
! 1 2 -1/2 0 1/2
! 4 1/12 -2/3 0 2/3 -1/12
! 6 -1/60 3/20 -3/4 0 3/4 -3/20 1/60
! 8 1/280 -4/105 1/5 -4/5 0 4/5 -1/5 4/105 -1/280
!---------------------------------------------------------------------------------------------------
! 2 2 1 -2 1
! 4 -1/12 4/3 -5/2 4/3 -1/12
! 6 1/90 -3/20 3/2 -49/18 3/2 -3/20 1/90
! 8 -1/560 8/315 -1/5 8/5 -205/72 8/5 -1/5 8/315 -1/560
!---------------------------------------------------------------------------------------------------
!> \par History
!> init 17.03.2020
!> \author JGH
! **************************************************************************************************
MODULE qs_fxc
USE cp_control_types, ONLY: dft_control_type
USE input_section_types, ONLY: section_vals_get_subs_vals,&
section_vals_type
USE kinds, ONLY: dp
USE pw_env_types, ONLY: pw_env_get,&
pw_env_type
USE pw_methods, ONLY: pw_axpy,&
pw_scale,&
pw_zero
USE pw_pool_types, ONLY: pw_pool_create_pw,&
pw_pool_give_back_pw,&
pw_pool_type
USE pw_types, ONLY: REALDATA3D,&
REALSPACE,&
pw_p_type
USE qs_ks_types, ONLY: get_ks_env,&
qs_ks_env_type
USE qs_rho_methods, ONLY: qs_rho_copy,&
qs_rho_scale_and_add
USE qs_rho_types, ONLY: qs_rho_create,&
qs_rho_get,&
qs_rho_release,&
qs_rho_type
USE qs_vxc, ONLY: qs_vxc_create
USE xc, ONLY: xc_calc_2nd_deriv,&
xc_prep_2nd_deriv
USE xc_derivative_set_types, ONLY: xc_derivative_set_type,&
xc_dset_release
USE xc_derivatives, ONLY: xc_functionals_get_needs
USE xc_rho_cflags_types, ONLY: xc_rho_cflags_type
USE xc_rho_set_types, ONLY: xc_rho_set_release,&
xc_rho_set_type
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
! *** Public subroutines ***
PUBLIC :: qs_fxc_fdiff, qs_fxc_analytic, qs_fgxc_create, qs_fgxc_release
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fxc'
! **************************************************************************************************
CONTAINS
! **************************************************************************************************
!> \brief ...
!> \param rho0 ...
!> \param rho1_r ...
!> \param xc_section ...
!> \param auxbas_pw_pool ...
!> \param is_triplet ...
!> \param v_xc ...
! **************************************************************************************************
SUBROUTINE qs_fxc_analytic(rho0, rho1_r, xc_section, auxbas_pw_pool, is_triplet, v_xc)
TYPE(qs_rho_type), POINTER :: rho0
TYPE(pw_p_type), DIMENSION(:), POINTER :: rho1_r
TYPE(section_vals_type), POINTER :: xc_section
TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
LOGICAL, INTENT(IN) :: is_triplet
TYPE(pw_p_type), DIMENSION(:), POINTER :: v_xc
CHARACTER(len=*), PARAMETER :: routineN = 'qs_fxc_analytic', &
routineP = moduleN//':'//routineN
INTEGER :: handle, nspins
INTEGER, DIMENSION(2, 3) :: bo
LOGICAL :: lsd
REAL(KIND=dp) :: fac
TYPE(pw_p_type), DIMENSION(:), POINTER :: rho0_g, rho0_r, rho1_g, tau0_r
TYPE(section_vals_type), POINTER :: xc_fun_section
TYPE(xc_derivative_set_type), POINTER :: deriv_set
TYPE(xc_rho_cflags_type) :: needs
TYPE(xc_rho_set_type), POINTER :: rho0_set
CALL timeset(routineN, handle)
CPASSERT(.NOT. ASSOCIATED(v_xc))
CALL qs_rho_get(rho0, rho_r=rho0_r, rho_g=rho0_g, tau_r=tau0_r)
nspins = SIZE(rho0_r)
lsd = (nspins == 2)
fac = 0._dp
IF (is_triplet .AND. nspins == 1) fac = -1.0_dp
NULLIFY (deriv_set, rho0_set)
NULLIFY (rho1_g)
bo = rho1_r(1)%pw%pw_grid%bounds_local
xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
needs = xc_functionals_get_needs(xc_fun_section, lsd, .TRUE.)
! calculate the arguments needed by the functionals
CALL xc_prep_2nd_deriv(deriv_set, rho0_set, rho0_r, auxbas_pw_pool, xc_section=xc_section)
CALL xc_calc_2nd_deriv(v_xc, deriv_set, rho0_set, rho1_r, rho1_g, &
auxbas_pw_pool, xc_section=xc_section, gapw=.FALSE., do_triplet=is_triplet)
CALL xc_dset_release(deriv_set)
CALL xc_rho_set_release(rho0_set)
CALL timestop(handle)
END SUBROUTINE qs_fxc_analytic
! **************************************************************************************************
!> \brief ...
!> \param ks_env ...
!> \param rho0_struct ...
!> \param rho1_struct ...
!> \param xc_section ...
!> \param accuracy ...
!> \param is_triplet ...
!> \param fxc_rho ...
!> \param fxc_tau ...
! **************************************************************************************************
SUBROUTINE qs_fxc_fdiff(ks_env, rho0_struct, rho1_struct, xc_section, accuracy, is_triplet, &
fxc_rho, fxc_tau)
TYPE(qs_ks_env_type), POINTER :: ks_env
TYPE(qs_rho_type), POINTER :: rho0_struct, rho1_struct
TYPE(section_vals_type), POINTER :: xc_section
INTEGER, INTENT(IN) :: accuracy
LOGICAL, INTENT(IN) :: is_triplet
TYPE(pw_p_type), DIMENSION(:), POINTER :: fxc_rho, fxc_tau
CHARACTER(len=*), PARAMETER :: routineN = 'qs_fxc_fdiff', routineP = moduleN//':'//routineN
REAL(KIND=dp), PARAMETER :: epsrho = 5.e-4_dp
INTEGER :: handle, ispin, istep, nspins, nstep
REAL(KIND=dp) :: alpha, beta, exc, oeps1
REAL(KIND=dp), DIMENSION(-4:4) :: ak
TYPE(dft_control_type), POINTER :: dft_control
TYPE(pw_env_type), POINTER :: pw_env
TYPE(pw_p_type), DIMENSION(:), POINTER :: v_tau_rspace, vxc00
TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
TYPE(qs_rho_type), POINTER :: rhoin
CALL timeset(routineN, handle)
CPASSERT(.NOT. ASSOCIATED(fxc_rho))
CPASSERT(.NOT. ASSOCIATED(fxc_tau))
CPASSERT(ASSOCIATED(rho0_struct))
CPASSERT(ASSOCIATED(rho1_struct))
ak = 0.0_dp
SELECT CASE (accuracy)
CASE (:4)
nstep = 2
ak(-2:2) = (/1.0_dp, -8.0_dp, 0.0_dp, 8.0_dp, -1.0_dp/)/12.0_dp
CASE (5:7)
nstep = 3
ak(-3:3) = (/-1.0_dp, 9.0_dp, -45.0_dp, 0.0_dp, 45.0_dp, -9.0_dp, 1.0_dp/)/60.0_dp
CASE (8:)
nstep = 4
ak(-4:4) = (/1.0_dp, -32.0_dp/3.0_dp, 56.0_dp, -224.0_dp, 0.0_dp, &
224.0_dp, -56.0_dp, 32.0_dp/3.0_dp, -1.0_dp/)/280.0_dp
END SELECT
CALL get_ks_env(ks_env, dft_control=dft_control, pw_env=pw_env)
CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
nspins = dft_control%nspins
exc = 0.0_dp
DO istep = -nstep, nstep
IF (ak(istep) /= 0.0_dp) THEN
alpha = 1.0_dp
beta = REAL(istep, KIND=dp)*epsrho
NULLIFY (rhoin)
CALL qs_rho_create(rhoin)
NULLIFY (vxc00, v_tau_rspace)
IF (is_triplet) THEN
CPASSERT(nspins == 1)
CALL qs_rho_copy(rho0_struct, rhoin, auxbas_pw_pool, 2)
CALL qs_rho_scale_and_add(rhoin, rho1_struct, alpha, 0.5_dp*beta)
CALL qs_vxc_create(ks_env=ks_env, rho_struct=rhoin, xc_section=xc_section, &
vxc_rho=vxc00, vxc_tau=v_tau_rspace, exc=exc, just_energy=.FALSE.)
CALL pw_axpy(vxc00(2)%pw, vxc00(1)%pw, -1.0_dp)
ELSE
CALL qs_rho_copy(rho0_struct, rhoin, auxbas_pw_pool, nspins)
CALL qs_rho_scale_and_add(rhoin, rho1_struct, alpha, beta)
CALL qs_vxc_create(ks_env=ks_env, rho_struct=rhoin, xc_section=xc_section, &
vxc_rho=vxc00, vxc_tau=v_tau_rspace, exc=exc, just_energy=.FALSE.)
END IF
CALL qs_rho_release(rhoin)
IF (.NOT. ASSOCIATED(fxc_rho)) THEN
ALLOCATE (fxc_rho(nspins))
DO ispin = 1, nspins
CALL pw_pool_create_pw(auxbas_pw_pool, fxc_rho(ispin)%pw, &
in_space=REALSPACE, use_data=REALDATA3D)
CALL pw_zero(fxc_rho(ispin)%pw)
END DO
END IF
!deb CPASSERT(.NOT. ASSOCIATED(v_tau_rspace))
DO ispin = 1, nspins
CALL pw_axpy(vxc00(ispin)%pw, fxc_rho(ispin)%pw, ak(istep))
END DO
DO ispin = 1, SIZE(vxc00)
CALL pw_pool_give_back_pw(auxbas_pw_pool, vxc00(ispin)%pw)
END DO
DEALLOCATE (vxc00)
END IF
END DO
oeps1 = 1.0_dp/epsrho
DO ispin = 1, nspins
CALL pw_scale(fxc_rho(ispin)%pw, oeps1)
END DO
CALL timestop(handle)
END SUBROUTINE qs_fxc_fdiff
! **************************************************************************************************
!> \brief ...
!> \param ks_env ...
!> \param rho0_struct ...
!> \param rho1_struct ...
!> \param xc_section ...
!> \param accuracy ...
!> \param is_triplet ...
!> \param fxc_rho ...
!> \param fxc_tau ...
!> \param gxc_rho ...
!> \param gxc_tau ...
! **************************************************************************************************
SUBROUTINE qs_fgxc_create(ks_env, rho0_struct, rho1_struct, xc_section, accuracy, is_triplet, &
fxc_rho, fxc_tau, gxc_rho, gxc_tau)
TYPE(qs_ks_env_type), POINTER :: ks_env
TYPE(qs_rho_type), POINTER :: rho0_struct, rho1_struct
TYPE(section_vals_type), POINTER :: xc_section
INTEGER, INTENT(IN) :: accuracy
LOGICAL, INTENT(IN) :: is_triplet
TYPE(pw_p_type), DIMENSION(:), POINTER :: fxc_rho, fxc_tau, gxc_rho, gxc_tau
CHARACTER(len=*), PARAMETER :: routineN = 'qs_fgxc_create', routineP = moduleN//':'//routineN
REAL(KIND=dp), PARAMETER :: epsrho = 5.e-4_dp
INTEGER :: handle, ispin, istep, nspins, nstep
REAL(KIND=dp) :: alpha, beta, exc, oeps1, oeps2
REAL(KIND=dp), DIMENSION(-4:4) :: ak, bl
TYPE(dft_control_type), POINTER :: dft_control
TYPE(pw_env_type), POINTER :: pw_env
TYPE(pw_p_type), DIMENSION(:), POINTER :: v_tau_rspace, vxc00
TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
TYPE(qs_rho_type), POINTER :: rhoin
CALL timeset(routineN, handle)
CPASSERT(.NOT. ASSOCIATED(fxc_rho))
CPASSERT(.NOT. ASSOCIATED(fxc_tau))
CPASSERT(.NOT. ASSOCIATED(gxc_rho))
CPASSERT(.NOT. ASSOCIATED(gxc_tau))
CPASSERT(ASSOCIATED(rho0_struct))
CPASSERT(ASSOCIATED(rho1_struct))
ak = 0.0_dp
bl = 0.0_dp
SELECT CASE (accuracy)
CASE (:4)
nstep = 2
ak(-2:2) = (/1.0_dp, -8.0_dp, 0.0_dp, 8.0_dp, -1.0_dp/)/12.0_dp
bl(-2:2) = (/-1.0_dp, 16.0_dp, -30.0_dp, 16.0_dp, -1.0_dp/)/12.0_dp
CASE (5:7)
nstep = 3
ak(-3:3) = (/-1.0_dp, 9.0_dp, -45.0_dp, 0.0_dp, 45.0_dp, -9.0_dp, 1.0_dp/)/60.0_dp
bl(-3:3) = (/2.0_dp, -27.0_dp, 270.0_dp, -490.0_dp, 270.0_dp, -27.0_dp, 2.0_dp/)/180.0_dp
CASE (8:)
nstep = 4
ak(-4:4) = (/1.0_dp, -32.0_dp/3.0_dp, 56.0_dp, -224.0_dp, 0.0_dp, &
224.0_dp, -56.0_dp, 32.0_dp/3.0_dp, -1.0_dp/)/280.0_dp
bl(-4:4) = (/-1.0_dp, 128.0_dp/9.0_dp, -112.0_dp, 896.0_dp, -14350.0_dp/9.0_dp, &
896.0_dp, -112.0_dp, 128.0_dp/9.0_dp, -1.0_dp/)/560.0_dp
END SELECT
CALL get_ks_env(ks_env, dft_control=dft_control, pw_env=pw_env)
CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
nspins = dft_control%nspins
exc = 0.0_dp
DO istep = -nstep, nstep
alpha = 1.0_dp
beta = REAL(istep, KIND=dp)*epsrho
NULLIFY (rhoin)
CALL qs_rho_create(rhoin)
NULLIFY (vxc00, v_tau_rspace)
IF (is_triplet) THEN
CPASSERT(nspins == 1)
CALL qs_rho_copy(rho0_struct, rhoin, auxbas_pw_pool, 2)
CALL qs_rho_scale_and_add(rhoin, rho1_struct, alpha, 0.5_dp*beta)
CALL qs_vxc_create(ks_env=ks_env, rho_struct=rhoin, xc_section=xc_section, &
vxc_rho=vxc00, vxc_tau=v_tau_rspace, exc=exc, just_energy=.FALSE.)
CALL pw_axpy(vxc00(2)%pw, vxc00(1)%pw, -1.0_dp)
ELSE
CALL qs_rho_copy(rho0_struct, rhoin, auxbas_pw_pool, nspins)
CALL qs_rho_scale_and_add(rhoin, rho1_struct, alpha, beta)
CALL qs_vxc_create(ks_env=ks_env, rho_struct=rhoin, xc_section=xc_section, &
vxc_rho=vxc00, vxc_tau=v_tau_rspace, exc=exc, just_energy=.FALSE.)
END IF
CALL qs_rho_release(rhoin)
IF (.NOT. ASSOCIATED(fxc_rho)) THEN
ALLOCATE (fxc_rho(nspins))
DO ispin = 1, nspins
CALL pw_pool_create_pw(auxbas_pw_pool, fxc_rho(ispin)%pw, &
in_space=REALSPACE, use_data=REALDATA3D)
CALL pw_zero(fxc_rho(ispin)%pw)
END DO
END IF
IF (.NOT. ASSOCIATED(gxc_rho)) THEN
ALLOCATE (gxc_rho(nspins))
DO ispin = 1, nspins
CALL pw_pool_create_pw(auxbas_pw_pool, gxc_rho(ispin)%pw, &
in_space=REALSPACE, use_data=REALDATA3D)
CALL pw_zero(gxc_rho(ispin)%pw)
END DO
END IF
CPASSERT(.NOT. ASSOCIATED(v_tau_rspace))
DO ispin = 1, nspins
IF (ak(istep) /= 0.0_dp) THEN
CALL pw_axpy(vxc00(ispin)%pw, fxc_rho(ispin)%pw, ak(istep))
END IF
IF (bl(istep) /= 0.0_dp) THEN
CALL pw_axpy(vxc00(ispin)%pw, gxc_rho(ispin)%pw, bl(istep))
END IF
END DO
DO ispin = 1, SIZE(vxc00)
CALL pw_pool_give_back_pw(auxbas_pw_pool, vxc00(ispin)%pw)
END DO
DEALLOCATE (vxc00)
END DO
oeps1 = 1.0_dp/epsrho
oeps2 = 1.0_dp/(epsrho**2)
DO ispin = 1, nspins
CALL pw_scale(fxc_rho(ispin)%pw, oeps1)
CALL pw_scale(gxc_rho(ispin)%pw, oeps2)
END DO
CALL timestop(handle)
END SUBROUTINE qs_fgxc_create
! **************************************************************************************************
!> \brief ...
!> \param ks_env ...
!> \param fxc_rho ...
!> \param fxc_tau ...
!> \param gxc_rho ...
!> \param gxc_tau ...
! **************************************************************************************************
SUBROUTINE qs_fgxc_release(ks_env, fxc_rho, fxc_tau, gxc_rho, gxc_tau)
TYPE(qs_ks_env_type), POINTER :: ks_env
TYPE(pw_p_type), DIMENSION(:), POINTER :: fxc_rho, fxc_tau, gxc_rho, gxc_tau
CHARACTER(len=*), PARAMETER :: routineN = 'qs_fgxc_release', &
routineP = moduleN//':'//routineN
INTEGER :: ispin
TYPE(pw_env_type), POINTER :: pw_env
TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
CALL get_ks_env(ks_env, pw_env=pw_env)
CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
IF (ASSOCIATED(fxc_rho)) THEN
DO ispin = 1, SIZE(fxc_rho)
CALL pw_pool_give_back_pw(auxbas_pw_pool, fxc_rho(ispin)%pw)
END DO
DEALLOCATE (fxc_rho)
END IF
IF (ASSOCIATED(fxc_tau)) THEN
DO ispin = 1, SIZE(fxc_tau)
CALL pw_pool_give_back_pw(auxbas_pw_pool, fxc_tau(ispin)%pw)
END DO
DEALLOCATE (fxc_tau)
END IF
IF (ASSOCIATED(gxc_rho)) THEN
DO ispin = 1, SIZE(gxc_rho)
CALL pw_pool_give_back_pw(auxbas_pw_pool, gxc_rho(ispin)%pw)
END DO
DEALLOCATE (gxc_rho)
END IF
IF (ASSOCIATED(gxc_tau)) THEN
DO ispin = 1, SIZE(gxc_tau)
CALL pw_pool_give_back_pw(auxbas_pw_pool, gxc_tau(ispin)%pw)
END DO
DEALLOCATE (gxc_tau)
END IF
END SUBROUTINE qs_fgxc_release
END MODULE qs_fxc

4
src/qs_gcp_method.F
View file

@ -124,9 +124,7 @@ CONTAINS
atener => atprop%ategcp
END IF
atstress = atprop%stress
IF (atstress) THEN
atstr => atprop%atstress
END IF
atstr => atprop%atstress
IF (unit_nr > 0) THEN
WRITE (unit_nr, *)

4
src/qs_initial_guess.F
View file

@ -66,6 +66,7 @@ MODULE qs_initial_guess
mp_sum
USE particle_methods, ONLY: get_particle_set
USE particle_types, ONLY: particle_type
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_dftb_utils, ONLY: get_dftb_atom_param
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
@ -74,8 +75,7 @@ MODULE qs_initial_guess
qs_kind_type
USE qs_mo_io, ONLY: read_mo_set_from_restart,&
wfn_restart_file_name
USE qs_mo_methods, ONLY: calculate_density_matrix,&
make_basis_lowdin,&
USE qs_mo_methods, ONLY: make_basis_lowdin,&
make_basis_simple,&
make_basis_sm
USE qs_mo_occupation, ONLY: set_mo_occupation

13
src/qs_kernel_types.F
View file

@ -8,6 +8,7 @@
MODULE qs_kernel_types
USE input_section_types, ONLY: section_vals_type
USE kinds, ONLY: dp
USE qs_tddfpt2_stda_types, ONLY: stda_env_type
USE xc_derivative_set_types, ONLY: xc_derivative_set_type,&
xc_dset_release
USE xc_rho_cflags_types, ONLY: xc_rho_cflags_type
@ -26,7 +27,7 @@ MODULE qs_kernel_types
INTEGER, PARAMETER, PRIVATE :: nderivs = 3
INTEGER, PARAMETER, PRIVATE :: maxspins = 2
PUBLIC :: full_kernel_env_type
PUBLIC :: full_kernel_env_type, kernel_env_type
PUBLIC :: release_kernel_env
! **************************************************************************************************
@ -57,6 +58,16 @@ MODULE qs_kernel_types
LOGICAL :: deriv2_analytic
LOGICAL :: deriv3_analytic
END TYPE full_kernel_env_type
! **************************************************************************************************
!> \brief Type to hold environments for the different kernels
!> \par History
!> * 04.2019 created [JHU]
! **************************************************************************************************
TYPE kernel_env_type
TYPE(full_kernel_env_type), POINTER :: full_kernel => Null()
TYPE(full_kernel_env_type), POINTER :: admm_kernel => Null()
TYPE(stda_env_type), POINTER :: stda_kernel => Null()
END TYPE kernel_env_type
CONTAINS

14
src/qs_kpp1_env_methods.F
View file

@ -220,6 +220,7 @@ CONTAINS
output_unit
LOGICAL :: gapw, gapw_xc, lsd, my_calc_forces
REAL(KIND=dp) :: alpha, energy_hartree, energy_hartree_1c
REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: vxg
TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
TYPE(cp_logger_type), POINTER :: logger
TYPE(cp_para_env_type), POINTER :: para_env
@ -360,7 +361,7 @@ CONTAINS
CALL xc_calc_2nd_deriv(v_xc, p_env%kpp1_env%deriv_set, p_env%kpp1_env%rho_set, &
rho1_r_pw, rho1_g_pw, auxbas_pw_pool, xc_section, .FALSE., &
NULL(), lsd_singlets, do_excitations, do_triplet, do_tddft, &
NULL(vxg), lsd_singlets, do_excitations, do_triplet, do_tddft, &
compute_virial=calc_virial, virial_xc=virial)
DO ispin = 1, nspins
@ -463,7 +464,6 @@ CONTAINS
qs_env=qs_env, &
calculate_forces=my_calc_forces, gapw=gapw)
END IF
END IF
CALL dbcsr_add(p_env%kpp1(ispin)%matrix, p_env%kpp1_env%v_ao(ispin)%matrix, 1.0_dp, alpha)
@ -763,13 +763,13 @@ CONTAINS
!> \brief ...
!> \param rho1 ...
!> \param rho1_tot_gspace ...
!> \param output_unit ...
!> \param out_unit ...
! **************************************************************************************************
SUBROUTINE print_densities(rho1, rho1_tot_gspace, output_unit)
SUBROUTINE print_densities(rho1, rho1_tot_gspace, out_unit)
TYPE(qs_rho_type), POINTER :: rho1
TYPE(pw_p_type), INTENT(IN) :: rho1_tot_gspace
INTEGER :: output_unit
INTEGER :: out_unit
REAL(KIND=dp) :: total_rho_gspace
REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho1_r
@ -777,9 +777,9 @@ CONTAINS
NULLIFY (tot_rho1_r)
total_rho_gspace = pw_integrate_function(rho1_tot_gspace%pw, isign=-1)
IF (output_unit > 0) THEN
IF (out_unit > 0) THEN
CALL qs_rho_get(rho1, tot_rho_r=tot_rho1_r)
WRITE (UNIT=output_unit, FMT="(T3,A,T60,F20.10)") &
WRITE (UNIT=out_unit, FMT="(T3,A,T60,F20.10)") &
"KPP1 total charge density (r-space):", &
accurate_sum(tot_rho1_r), &
"KPP1 total charge density (g-space):", &

36
src/qs_kpp1_env_types.F
View file

@ -41,21 +41,32 @@ MODULE qs_kpp1_env_types
!> \param v_ao the potential in the ao basis (used togheter with v_rspace
!> to update only what changed
!> \param id_nr identification number, unique for each kpp1 env
!> \param print_count counter to create unique filename
!> \param iter number of iterations
!> \param drho_r (idir,ispin): the derivative of rho wrt. x,y,z in the real space
!> \param deriv_xc (ii,ipot): the second derivative of the xc potential at psi0
!> (qs_env%c), if grad pot is true it should already be divised
!> by the gradient
!> \param spin_pot (1:2,ipot): information about wrt. to which spins the
!> corresponding component of deriv_xc was derived (see
!> xc_create_2nd_deriv_info)
!> \param grad_pot (1:2,ipot): if the derivative spin_pot was wrt. to
!> the gradient (see xc_create_2nd_deriv_info)
!> \param ndiag_term (ipot): it the term is an off diagonal term (see
!> xc_create_2nd_deriv_info)
! **************************************************************************************************
TYPE qs_kpp1_env_type
INTEGER :: ref_count, id_nr
TYPE(pw_p_type), DIMENSION(:), POINTER :: v_rspace
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: v_ao
TYPE(pw_p_type), DIMENSION(:, :), POINTER :: drho_r
TYPE(xc_derivative_set_type), POINTER :: deriv_set
TYPE(xc_rho_set_type), POINTER :: rho_set
TYPE(xc_derivative_set_type), POINTER :: deriv_set_admm
TYPE(xc_rho_set_type), POINTER :: rho_set_admm
INTEGER :: ref_count, id_nr, print_count, iter
TYPE(pw_p_type), DIMENSION(:), POINTER :: v_rspace => NULL()
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: v_ao => NULL()
TYPE(pw_p_type), DIMENSION(:, :), POINTER :: drho_r => NULL()
TYPE(xc_derivative_set_type), POINTER :: deriv_set => NULL()
TYPE(xc_rho_set_type), POINTER :: rho_set => NULL()
TYPE(xc_derivative_set_type), POINTER :: deriv_set_admm => NULL()
TYPE(xc_rho_set_type), POINTER :: rho_set_admm => NULL()
INTEGER, DIMENSION(:, :), POINTER :: spin_pot => NULL()
LOGICAL, DIMENSION(:, :), POINTER :: grad_pot => NULL()
LOGICAL, DIMENSION(:), POINTER :: ndiag_term => NULL()
END TYPE qs_kpp1_env_type
! **************************************************************************************************
@ -120,6 +131,15 @@ CONTAINS
CALL xc_rho_set_release(kpp1_env%rho_set_admm)
NULLIFY (kpp1_env%rho_set_admm)
END IF
IF (ASSOCIATED(kpp1_env%spin_pot)) THEN
DEALLOCATE (kpp1_env%spin_pot)
END IF
IF (ASSOCIATED(kpp1_env%grad_pot)) THEN
DEALLOCATE (kpp1_env%grad_pot)
END IF
IF (ASSOCIATED(kpp1_env%ndiag_term)) THEN
DEALLOCATE (kpp1_env%ndiag_term)
END IF
DEALLOCATE (kpp1_env)
END IF
END IF

234
src/qs_ks_methods.F
View file

@ -28,31 +28,17 @@ MODULE qs_ks_methods
admm_update_ks_atom
USE admm_types, ONLY: admm_type
USE cell_types, ONLY: cell_type
USE cp_blacs_env, ONLY: cp_blacs_env_type
USE cp_control_types, ONLY: dft_control_type
USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
copy_fm_to_dbcsr,&
cp_dbcsr_plus_fm_fm_t,&
cp_dbcsr_sm_fm_multiply,&
dbcsr_allocate_matrix_set,&
dbcsr_copy_columns_hack
USE cp_ddapc, ONLY: qs_ks_ddapc
USE cp_fm_basic_linalg, ONLY: cp_fm_column_scale,&
cp_fm_scale_and_add,&
cp_fm_symm,&
cp_fm_transpose,&
cp_fm_upper_to_full
USE cp_fm_struct, ONLY: cp_fm_struct_create,&
cp_fm_struct_release,&
cp_fm_struct_type
USE cp_fm_types, ONLY: cp_fm_create,&
cp_fm_get_info,&
cp_fm_p_type,&
cp_fm_release,&
cp_fm_to_fm,&
cp_fm_type
USE cp_gemm_interface, ONLY: cp_gemm
USE cp_log_handling, ONLY: cp_get_default_logger,&
cp_logger_get_default_io_unit,&
cp_logger_type
@ -135,8 +121,7 @@ MODULE qs_ks_methods
sic_explicit_orbitals, sum_up_and_integrate
USE qs_local_rho_types, ONLY: local_rho_type
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type,&
mo_set_type
mo_set_p_type
USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
USE qs_rho0_ggrid, ONLY: integrate_vhg0_rspace
USE qs_rho_types, ONLY: qs_rho_get,&
@ -156,17 +141,11 @@ MODULE qs_ks_methods
PRIVATE
INTERFACE calculate_w_matrix
MODULE PROCEDURE calculate_w_matrix_1, &
calculate_w_matrix_roks
END INTERFACE
LOGICAL, PARAMETER :: debug_this_module = .TRUE.
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_ks_methods'
PUBLIC :: calc_rho_tot_gspace, qs_ks_update_qs_env, qs_ks_build_kohn_sham_matrix, &
calculate_w_matrix, calculate_w_matrix_ot, qs_ks_allocate_basics
qs_ks_allocate_basics
CONTAINS
@ -733,6 +712,12 @@ CONTAINS
END IF
END IF
ELSE
IF (do_hfx) THEN
IF (.FALSE.) THEN
CPWARN("KS matrix not longer correct. Check possible problems with property calculations!")
END IF
END IF
END IF ! .NOT. just energy
IF (dft_control%qs_control%ddapc_explicit_potential) THEN
@ -1240,209 +1225,6 @@ CONTAINS
END SUBROUTINE rebuild_ks_matrix
! **************************************************************************************************
!> \brief Calculate the W matrix from the MO eigenvectors, MO eigenvalues,
!> and the MO occupation numbers. Only works if they are eigenstates
!> \param mo_set type containing the full matrix of the MO and the eigenvalues
!> \param w_matrix sparse matrix
!> error
!> \par History
!> Creation (03.03.03,MK)
!> Modification that computes it as a full block, several times (e.g. 20)
!> faster at the cost of some additional memory
!> \author MK
! **************************************************************************************************
SUBROUTINE calculate_w_matrix_1(mo_set, w_matrix)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(dbcsr_type), POINTER :: w_matrix
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_w_matrix_1'
INTEGER :: handle, imo
REAL(KIND=dp), DIMENSION(:), POINTER :: eigocc
TYPE(cp_fm_type), POINTER :: weighted_vectors
CALL timeset(routineN, handle)
NULLIFY (weighted_vectors)
CALL dbcsr_set(w_matrix, 0.0_dp)
CALL cp_fm_create(weighted_vectors, mo_set%mo_coeff%matrix_struct, "weighted_vectors")
CALL cp_fm_to_fm(mo_set%mo_coeff, weighted_vectors)
! scale every column with the occupation
ALLOCATE (eigocc(mo_set%homo))
DO imo = 1, mo_set%homo
eigocc(imo) = mo_set%eigenvalues(imo)*mo_set%occupation_numbers(imo)
ENDDO
CALL cp_fm_column_scale(weighted_vectors, eigocc)
DEALLOCATE (eigocc)
CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=w_matrix, &
matrix_v=mo_set%mo_coeff, &
matrix_g=weighted_vectors, &
ncol=mo_set%homo)
CALL cp_fm_release(weighted_vectors)
CALL timestop(handle)
END SUBROUTINE calculate_w_matrix_1
! **************************************************************************************************
!> \brief Calculate the W matrix from the MO coefs, MO derivs
!> could overwrite the mo_derivs for increased memory efficiency
!> \param mo_set type containing the full matrix of the MO coefs
!> mo_deriv:
!> \param mo_deriv ...
!> \param w_matrix sparse matrix
!> \param s_matrix sparse matrix for the overlap
!> error
!> \par History
!> Creation (JV)
!> \author MK
! **************************************************************************************************
SUBROUTINE calculate_w_matrix_ot(mo_set, mo_deriv, w_matrix, s_matrix)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(dbcsr_type), POINTER :: mo_deriv, w_matrix, s_matrix
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_w_matrix_ot'
LOGICAL, PARAMETER :: check_gradient = .FALSE., &
do_symm = .FALSE.
INTEGER :: handle, ncol_block, ncol_global, &
nrow_block, nrow_global
REAL(KIND=dp), DIMENSION(:), POINTER :: occupation_numbers, scaling_factor
TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
TYPE(cp_fm_type), POINTER :: gradient, h_block, h_block_t, &
weighted_vectors
CALL timeset(routineN, handle)
NULLIFY (weighted_vectors, h_block, fm_struct_tmp)
CALL cp_fm_get_info(matrix=mo_set%mo_coeff, &
ncol_global=ncol_global, &
nrow_global=nrow_global, &
nrow_block=nrow_block, &
ncol_block=ncol_block)
CALL cp_fm_create(weighted_vectors, mo_set%mo_coeff%matrix_struct, "weighted_vectors")
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol_global, ncol_global=ncol_global, &
para_env=mo_set%mo_coeff%matrix_struct%para_env, &
context=mo_set%mo_coeff%matrix_struct%context)
CALL cp_fm_create(h_block, fm_struct_tmp, name="h block")
IF (do_symm) CALL cp_fm_create(h_block_t, fm_struct_tmp, name="h block t")
CALL cp_fm_struct_release(fm_struct_tmp)
CALL get_mo_set(mo_set=mo_set, occupation_numbers=occupation_numbers)
ALLOCATE (scaling_factor(SIZE(occupation_numbers)))
scaling_factor = 2.0_dp*occupation_numbers
CALL copy_dbcsr_to_fm(mo_deriv, weighted_vectors)
CALL cp_fm_column_scale(weighted_vectors, scaling_factor)
DEALLOCATE (scaling_factor)
! the convention seems to require the half here, the factor of two is presumably taken care of
! internally in qs_core_hamiltonian
CALL cp_gemm('T', 'N', ncol_global, ncol_global, nrow_global, 0.5_dp, &
mo_set%mo_coeff, weighted_vectors, 0.0_dp, h_block)
IF (do_symm) THEN
! at the minimum things are anyway symmetric, but numerically it might not be the case
! needs some investigation to find out if using this is better
CALL cp_fm_transpose(h_block, h_block_t)
CALL cp_fm_scale_and_add(0.5_dp, h_block, 0.5_dp, h_block_t)
ENDIF
! this could overwrite the mo_derivs to save the weighted_vectors
CALL cp_gemm('N', 'N', nrow_global, ncol_global, ncol_global, 1.0_dp, &
mo_set%mo_coeff, h_block, 0.0_dp, weighted_vectors)
CALL dbcsr_set(w_matrix, 0.0_dp)
CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=w_matrix, &
matrix_v=mo_set%mo_coeff, &
matrix_g=weighted_vectors, &
ncol=mo_set%homo)
IF (check_gradient) THEN
CALL cp_fm_create(gradient, mo_set%mo_coeff%matrix_struct, "gradient")
CALL cp_dbcsr_sm_fm_multiply(s_matrix, weighted_vectors, &
gradient, ncol_global)
ALLOCATE (scaling_factor(SIZE(occupation_numbers)))
scaling_factor = 2.0_dp*occupation_numbers
CALL copy_dbcsr_to_fm(mo_deriv, weighted_vectors)
CALL cp_fm_column_scale(weighted_vectors, scaling_factor)
DEALLOCATE (scaling_factor)
WRITE (*, *) " maxabs difference ", MAXVAL(ABS(weighted_vectors%local_data - 2.0_dp*gradient%local_data))
CALL cp_fm_release(gradient)
ENDIF
IF (do_symm) CALL cp_fm_release(h_block_t)
CALL cp_fm_release(weighted_vectors)
CALL cp_fm_release(h_block)
CALL timestop(handle)
END SUBROUTINE calculate_w_matrix_ot
! **************************************************************************************************
!> \brief Calculate the energy-weighted density matrix W if ROKS is active.
!> The W matrix is returned in matrix_w.
!> \param mo_set ...
!> \param matrix_ks ...
!> \param matrix_p ...
!> \param matrix_w ...
!> \author 04.05.06,MK
! **************************************************************************************************
SUBROUTINE calculate_w_matrix_roks(mo_set, matrix_ks, matrix_p, matrix_w)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(dbcsr_type), POINTER :: matrix_ks, matrix_p, matrix_w
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_w_matrix_roks'
INTEGER :: handle, nao
TYPE(cp_blacs_env_type), POINTER :: context
TYPE(cp_fm_struct_type), POINTER :: fm_struct
TYPE(cp_fm_type), POINTER :: c, ks, p, work
TYPE(cp_para_env_type), POINTER :: para_env
CALL timeset(routineN, handle)
NULLIFY (c)
NULLIFY (context)
NULLIFY (fm_struct)
NULLIFY (ks)
NULLIFY (p)
NULLIFY (para_env)
NULLIFY (work)
CALL get_mo_set(mo_set=mo_set, mo_coeff=c)
CALL cp_fm_get_info(c, context=context, nrow_global=nao, para_env=para_env)
CALL cp_fm_struct_create(fm_struct, context=context, nrow_global=nao, &
ncol_global=nao, para_env=para_env)
CALL cp_fm_create(ks, fm_struct, name="Kohn-Sham matrix")
CALL cp_fm_create(p, fm_struct, name="Density matrix")
CALL cp_fm_create(work, fm_struct, name="Work matrix")
CALL cp_fm_struct_release(fm_struct)
CALL copy_dbcsr_to_fm(matrix_ks, ks)
CALL copy_dbcsr_to_fm(matrix_p, p)
CALL cp_fm_upper_to_full(p, work)
CALL cp_fm_symm("L", "U", nao, nao, 1.0_dp, ks, p, 0.0_dp, work)
CALL cp_gemm("T", "N", nao, nao, nao, 1.0_dp, p, work, 0.0_dp, ks)
CALL dbcsr_set(matrix_w, 0.0_dp)
CALL copy_fm_to_dbcsr(ks, matrix_w, keep_sparsity=.TRUE.)
CALL cp_fm_release(work)
CALL cp_fm_release(p)
CALL cp_fm_release(ks)
CALL timestop(handle)
END SUBROUTINE calculate_w_matrix_roks
! **************************************************************************************************
!> \brief Allocate ks_matrix and ks_env if necessary
!> \param qs_env ...

1186
src/qs_linres_kernel.F Normal file
View file

File diff suppressed because it is too large Load diff

420
src/qs_linres_methods.F
View file

@ -13,9 +13,6 @@
!> \author MI
! **************************************************************************************************
MODULE qs_linres_methods
USE admm_types, ONLY: admm_type
USE atomic_kind_types, ONLY: atomic_kind_type,&
get_atomic_kind
USE cp_control_types, ONLY: dft_control_type
USE cp_dbcsr_operations, ONLY: cp_dbcsr_sm_fm_multiply
USE cp_external_control, ONLY: external_control
@ -51,36 +48,25 @@ MODULE qs_linres_methods
dbcsr_set,&
dbcsr_type
USE input_constants, ONLY: do_loc_none,&
kg_tnadd_embed,&
op_loc_berry,&
ot_precond_none,&
ot_precond_solver_default,&
state_loc_all
USE input_section_types, ONLY: section_vals_get,&
section_vals_get_subs_vals,&
USE input_section_types, ONLY: section_vals_get_subs_vals,&
section_vals_type,&
section_vals_val_get
USE kg_correction, ONLY: kg_ekin_subset
USE kinds, ONLY: default_path_length,&
default_string_length,&
dp
USE machine, ONLY: m_flush,&
m_walltime
USE message_passing, ONLY: mp_bcast
USE mulliken, ONLY: ao_charges
USE particle_types, ONLY: particle_type
USE preconditioner, ONLY: apply_preconditioner,&
make_preconditioner
USE pw_env_types, ONLY: pw_env_type
USE qs_2nd_kernel_ao, ONLY: apply_hfx_ao,&
apply_xc_admm_ao,&
build_dm_response
USE qs_2nd_kernel_ao, ONLY: build_dm_response
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
USE qs_kind_types, ONLY: get_qs_kind,&
get_qs_kind_set,&
qs_kind_type
USE qs_kpp1_env_methods, ONLY: calc_kpp1
USE qs_linres_kernel, ONLY: apply_op_2
USE qs_linres_types, ONLY: linres_control_type
USE qs_loc_methods, ONLY: qs_loc_driver
USE qs_loc_types, ONLY: get_qs_loc_env,&
@ -95,16 +81,11 @@ MODULE qs_linres_methods
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type
USE qs_p_env_methods, ONLY: p_env_check_i_alloc,&
p_env_finish_kpp1,&
p_env_update_rho
USE qs_p_env_types, ONLY: qs_p_env_type
USE qs_rho_methods, ONLY: qs_rho_update_rho
USE qs_rho_types, ONLY: qs_rho_get,&
qs_rho_type
USE qs_rho_types, ONLY: qs_rho_type
USE string_utilities, ONLY: xstring
USE xtb_ehess, ONLY: xtb_coulomb_hessian
USE xtb_types, ONLY: get_xtb_atom_param,&
xtb_atom_type
#include "./base/base_uses.f90"
IMPLICIT NONE
@ -247,10 +228,9 @@ CONTAINS
INTEGER :: handle, ispin, iter, maxnmo, maxnmo_o, &
nao, ncol, nmo, nspins
LOGICAL :: restart
REAL(dp) :: norm_res, t1, t2
REAL(dp), DIMENSION(:), POINTER :: alpha, beta, tr_pAp, tr_rz0, tr_rz00, &
tr_rz1
TYPE(cp_fm_p_type), ALLOCATABLE, DIMENSION(:) :: Ap, chc, mo_coeff_array, p, r, Sc, z
REAL(dp) :: alpha, beta, norm_res, t1, t2
REAL(dp), DIMENSION(:), POINTER :: tr_pAp, tr_rz0, tr_rz00, tr_rz1
TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: Ap, chc, mo_coeff_array, p, r, Sc, z
TYPE(cp_fm_struct_type), POINTER :: tmp_fm_struct
TYPE(cp_fm_type), POINTER :: buf, mo_coeff
TYPE(cp_para_env_type), POINTER :: para_env
@ -290,7 +270,7 @@ CONTAINS
CALL check_p_env_init(p_env, linres_control, nspins)
!
! allocate the vectors
ALLOCATE (alpha(nspins), beta(nspins), tr_pAp(nspins), tr_rz0(nspins), tr_rz00(nspins), tr_rz1(nspins), &
ALLOCATE (tr_pAp(nspins), tr_rz0(nspins), tr_rz00(nspins), tr_rz1(nspins), &
r(nspins), p(nspins), z(nspins), Ap(nspins), mo_coeff_array(nspins))
DO ispin = 1, nspins
CALL get_mo_set(mos(ispin)%mo_set, mo_coeff=mo_coeff)
@ -334,8 +314,6 @@ CONTAINS
CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, mo_coeff, Sc(ispin)%matrix, ncol)
ENDDO
!
!
!
! header
IF (iounit > 0) THEN
WRITE (iounit, "(/,T3,A,T16,A,T25,A,T38,A,T52,A,T72,A,/,T3,A)") &
@ -349,6 +327,7 @@ CONTAINS
! build the preconditioner
IF (linres_control%preconditioner_type /= ot_precond_none) THEN
IF (p_env%new_preconditioner) THEN
p_env%os_valid = .FALSE.
DO ispin = 1, nspins
IF (ASSOCIATED(matrix_t)) THEN
CALL make_preconditioner(p_env%preconditioner(ispin), &
@ -401,7 +380,6 @@ CONTAINS
linres_control%flag = "PCG"
ENDIF
!
norm_res = 0.0_dp
DO ispin = 1, nspins
!
! p_0 = z_0
@ -409,11 +387,11 @@ CONTAINS
!
! trace(r_0 * z_0)
CALL cp_fm_trace(r(ispin)%matrix, z(ispin)%matrix, tr_rz0(ispin))
IF (tr_rz0(ispin) .LT. 0.0_dp) CPABORT("tr(r_j*z_j) < 0")
norm_res = MAX(norm_res, ABS(tr_rz0(ispin))/SQRT(REAL(nao*maxnmo_o, dp)))
ENDDO
IF (SUM(tr_rz0) < 0.0_dp) CPABORT("tr(r_j*z_j) < 0")
norm_res = ABS(SUM(tr_rz0))/SQRT(REAL(nspins*nao*maxnmo_o, dp))
!
alpha(:) = 0.0_dp
alpha = 0.0_dp
restart = .FALSE.
should_stop = .FALSE.
iteration: DO iter = 1, linres_control%max_iter
@ -425,23 +403,24 @@ CONTAINS
ENDIF
!
t2 = m_walltime()
IF (iter .EQ. 1 .OR. MOD(iter, 1) .EQ. 0 .OR. linres_control%converged .OR. restart .OR. should_stop) THEN
IF (iter .EQ. 1 .OR. MOD(iter, 1) .EQ. 0 .OR. linres_control%converged &
.OR. restart .OR. should_stop) THEN
IF (iounit > 0) THEN
WRITE (iounit, "(T5,I5,T18,A3,T28,L1,T38,1E8.2,T48,F16.10,T68,F8.2)") &
iter, linres_control%flag, restart, MAXVAL(alpha), norm_res, t2 - t1
iter, linres_control%flag, restart, alpha, norm_res, t2 - t1
CALL m_flush(iounit)
ENDIF
ENDIF
!
IF (linres_control%converged) THEN
IF (iounit > 0) THEN
WRITE (iounit, "(/,T2,A,I4,A,/)") "The linear solver converged in ", iter, " iterations."
WRITE (iounit, "(T3,A,I4,A)") "The linear solver converged in ", iter, " iterations."
CALL m_flush(iounit)
ENDIF
EXIT iteration
ELSE IF (should_stop) THEN
IF (iounit > 0) THEN
WRITE (iounit, "(/,T2,A,I4,A,/)") "The linear solver did NOT converge! External stop"
WRITE (iounit, "(T3,A,I4,A)") "The linear solver did NOT converge! External stop"
CALL m_flush(iounit)
END IF
EXIT iteration
@ -450,8 +429,8 @@ CONTAINS
! Max number of iteration reached
IF (iter == linres_control%max_iter) THEN
IF (iounit > 0) THEN
WRITE (iounit, "(/,T2,A/)") &
"The linear solver didnt converge! Maximum number of iterations reached."
WRITE (iounit, "(T3,A)") &
"The linear solver didn't converge! Maximum number of iterations reached."
CALL m_flush(iounit)
ENDIF
linres_control%converged = .FALSE.
@ -467,35 +446,18 @@ CONTAINS
!
! tr(Ap_j*p_j)
CALL cp_fm_trace(Ap(ispin)%matrix, p(ispin)%matrix, tr_pAp(ispin))
IF (tr_pAp(ispin) .LT. 0.0_dp) THEN
! try to fix it by getting rid of the preconditioner
IF (iter > 1) THEN
CALL cp_fm_scale_and_add(beta(ispin), p(ispin)%matrix, -1.0_dp, z(ispin)%matrix)
CALL cp_fm_trace(r(ispin)%matrix, r(ispin)%matrix, tr_rz1(ispin))
beta(ispin) = tr_rz1(ispin)/tr_rz00(ispin)
CALL cp_fm_scale_and_add(beta(ispin), p(ispin)%matrix, 1.0_dp, r(ispin)%matrix)
tr_rz0(ispin) = tr_rz1(ispin)
ELSE
CALL cp_fm_to_fm(r(ispin)%matrix, p(ispin)%matrix)
CALL cp_fm_trace(r(ispin)%matrix, r(ispin)%matrix, tr_rz0(ispin))
END IF
linres_control%flag = "CG"
CALL apply_op(qs_env, p_env, psi0_order, p, Ap, chc)
CALL postortho(Ap, mo_coeff_array, Sc)
CALL cp_fm_trace(Ap(ispin)%matrix, p(ispin)%matrix, tr_pAp(ispin))
CPABORT("tr(Ap_j*p_j) < 0")
END IF
!
! alpha = tr(r_j*z_j) / tr(Ap_j*p_j)
IF (tr_pAp(ispin) .LT. 1.0e-10_dp) THEN
alpha(ispin) = 1.0_dp
ELSE
alpha(ispin) = tr_rz0(ispin)/tr_pAp(ispin)
ENDIF
END DO
!
! alpha = tr(r_j*z_j) / tr(Ap_j*p_j)
IF (SUM(tr_pAp) < 1.0e-10_dp) THEN
alpha = 1.0_dp
ELSE
alpha = SUM(tr_rz0)/SUM(tr_pAp)
ENDIF
DO ispin = 1, nspins
!
! x_j+1 = x_j + alpha * p_j
CALL cp_fm_scale_and_add(1.0_dp, psi1(ispin)%matrix, alpha(ispin), p(ispin)%matrix)
CALL cp_fm_scale_and_add(1.0_dp, psi1(ispin)%matrix, alpha, p(ispin)%matrix)
ENDDO
!
! need to recompute the residue
@ -519,7 +481,7 @@ CONTAINS
!
! r_j+1 = r_j - alpha * Ap_j
DO ispin = 1, nspins
CALL cp_fm_scale_and_add(1.0_dp, r(ispin)%matrix, -alpha(ispin), Ap(ispin)%matrix)
CALL cp_fm_scale_and_add(1.0_dp, r(ispin)%matrix, -alpha, Ap(ispin)%matrix)
ENDDO
restart = .FALSE.
ENDIF
@ -543,27 +505,28 @@ CONTAINS
linres_control%flag = "PCG"
ENDIF
!
norm_res = 0.0_dp
DO ispin = 1, nspins
!
! tr(r_j+1*z_j+1)
CALL cp_fm_trace(r(ispin)%matrix, z(ispin)%matrix, tr_rz1(ispin))
IF (tr_rz1(ispin) .LT. 0.0_dp) CPABORT("tr(r_j+1*z_j+1) < 0")
norm_res = MAX(norm_res, tr_rz1(ispin)/SQRT(REAL(nao*maxnmo_o, dp)))
!
! beta = tr(r_j+1*z_j+1) / tr(r_j*z_j)
IF (tr_rz0(ispin) .LT. 1.0e-10_dp) THEN
beta(ispin) = 0.0_dp
ELSE
beta(ispin) = tr_rz1(ispin)/tr_rz0(ispin)
ENDIF
END DO
IF (SUM(tr_rz1) < 0.0_dp) CPABORT("tr(r_j+1*z_j+1) < 0")
norm_res = SUM(tr_rz1)/SQRT(REAL(nspins*nao*maxnmo_o, dp))
!
! beta = tr(r_j+1*z_j+1) / tr(r_j*z_j)
IF (SUM(tr_rz0) < 1.0e-10_dp) THEN
beta = 0.0_dp
ELSE
beta = SUM(tr_rz1)/SUM(tr_rz0)
ENDIF
DO ispin = 1, nspins
!
! p_j+1 = z_j+1 + beta * p_j
CALL cp_fm_scale_and_add(beta(ispin), p(ispin)%matrix, 1.0_dp, z(ispin)%matrix)
CALL cp_fm_scale_and_add(beta, p(ispin)%matrix, 1.0_dp, z(ispin)%matrix)
tr_rz00(ispin) = tr_rz0(ispin)
tr_rz0(ispin) = tr_rz1(ispin)
ENDDO
!
! Can we exit the SCF loop?
CALL external_control(should_stop, "LINRES", target_time=qs_env%target_time, &
start_time=qs_env%start_time)
@ -584,7 +547,7 @@ CONTAINS
CALL cp_fm_release(Sc(ispin)%matrix)
CALL cp_fm_release(chc(ispin)%matrix)
ENDDO
DEALLOCATE (alpha, beta, tr_pAp, tr_rz0, tr_rz00, tr_rz1, r, p, z, Ap, Sc, chc, mo_coeff_array)
DEALLOCATE (tr_pAp, tr_rz0, tr_rz00, tr_rz1, r, p, z, Ap, Sc, chc, mo_coeff_array)
!
CALL timestop(handle)
!
@ -603,7 +566,7 @@ CONTAINS
!
TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env
TYPE(cp_fm_p_type), DIMENSION(:), INTENT(INOUT) :: c0, v, Av, chc
TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: c0, v, Av, chc
CHARACTER(LEN=*), PARAMETER :: routineN = 'apply_op'
@ -659,7 +622,7 @@ CONTAINS
IF (ASSOCIATED(p_env%kpp1_admm)) CALL dbcsr_set(p_env%kpp1_admm(ispin)%matrix, 0.0_dp)
END DO
CALL apply_op_2(qs_env, p_env, c0, Av)
CALL apply_op_2(qs_env, p_env, c0, v, Av)
ENDIF
@ -712,293 +675,12 @@ CONTAINS
!
END SUBROUTINE apply_op_1
!MERGE
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param p_env ...
!> \param c0 ...
!> \param Av ...
! **************************************************************************************************
SUBROUTINE apply_op_2(qs_env, p_env, c0, Av)
!
TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env
TYPE(cp_fm_p_type), DIMENSION(:), INTENT(INOUT) :: c0, Av
INTEGER :: ispin, ncol
TYPE(dft_control_type), POINTER :: dft_control
CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
IF (dft_control%qs_control%semi_empirical) THEN
CPABORT("Linear response not available with SE methods")
ELSEIF (dft_control%qs_control%dftb) THEN
CPABORT("Linear response not available with DFTB")
ELSEIF (dft_control%qs_control%xtb) THEN
CALL apply_op_2_xtb(qs_env, p_env)
ELSE
CALL apply_op_2_dft(qs_env, p_env)
CALL apply_hfx(qs_env, p_env)
CALL apply_xc_admm(qs_env, p_env)
CALL p_env_finish_kpp1(qs_env, p_env)
END IF
! Transform second index in AO basis
DO ispin = 1, SIZE(p_env%kpp1)
CALL cp_fm_get_info(c0(ispin)%matrix, ncol_global=ncol)
CALL cp_dbcsr_sm_fm_multiply(p_env%kpp1(ispin)%matrix, c0(ispin)%matrix, Av(ispin)%matrix, &
ncol=ncol, alpha=1.0_dp, beta=1.0_dp)
END DO
END SUBROUTINE apply_op_2
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param p_env ...
! **************************************************************************************************
SUBROUTINE apply_op_2_dft(qs_env, p_env)
TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env
CHARACTER(len=*), PARAMETER :: routineN = 'apply_op_2_dft'
INTEGER :: handle, nspins
LOGICAL :: gapw, gapw_xc, lr_triplet, lrigpw
REAL(KIND=dp) :: ekin_mol
TYPE(admm_type), POINTER :: admm_env
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho1_ao
TYPE(dft_control_type), POINTER :: dft_control
TYPE(linres_control_type), POINTER :: linres_control
TYPE(qs_rho_type), POINTER :: rho1, rho1_xc
TYPE(section_vals_type), POINTER :: input, xc_section
CALL timeset(routineN, handle)
NULLIFY (rho1_ao, input, dft_control)
rho1 => p_env%rho1
rho1_xc => p_env%rho1_xc
CPASSERT(ASSOCIATED(rho1))
CALL get_qs_env(qs_env=qs_env, &
input=input, &
linres_control=linres_control, &
dft_control=dft_control)
lrigpw = dft_control%qs_control%lrigpw
lr_triplet = linres_control%lr_triplet
gapw = dft_control%qs_control%gapw
gapw_xc = dft_control%qs_control%gapw_xc
IF (dft_control%do_admm) THEN
CALL get_qs_env(qs_env, admm_env=admm_env)
xc_section => admm_env%xc_section_primary
ELSE
xc_section => section_vals_get_subs_vals(input, "DFT%XC")
END IF
CALL calc_kpp1(rho1_xc, rho1, xc_section, .FALSE., &
.FALSE., lrigpw, .TRUE., lr_triplet, &
qs_env, p_env)
nspins = SIZE(p_env%kpp1)
! KG embedding, contribution of kinetic energy functional to kernel
IF (dft_control%qs_control%do_kg .AND. .NOT. (lr_triplet .OR. gapw .OR. gapw_xc)) THEN
IF (qs_env%kg_env%tnadd_method == kg_tnadd_embed) THEN
ekin_mol = 0.0_dp
CALL qs_rho_get(rho1, rho_ao=rho1_ao)
CALL kg_ekin_subset(qs_env=qs_env, &
ks_matrix=p_env%kpp1, &
ekin_mol=ekin_mol, &
calc_force=.FALSE., &
do_kernel=.TRUE., &
pmat_ext=rho1_ao)
END IF
END IF
CALL timestop(handle)
END SUBROUTINE apply_op_2_dft
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param p_env ...
! **************************************************************************************************
SUBROUTINE apply_op_2_xtb(qs_env, p_env)
TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env
CHARACTER(len=*), PARAMETER :: routineN = 'apply_op_2_xtb'
INTEGER :: atom_a, handle, iatom, ikind, is, ispin, &
na, natom, natorb, nkind, ns, nsgf, &
nspins
INTEGER, DIMENSION(25) :: lao
INTEGER, DIMENSION(5) :: occ
LOGICAL :: lr_triplet
REAL(dp), ALLOCATABLE, DIMENSION(:) :: mcharge, mcharge1
REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: aocg, aocg1, charges, charges1
TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
TYPE(cp_para_env_type), POINTER :: para_env
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: p_matrix, rho_ao
TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_p, matrix_p1, matrix_s
TYPE(dbcsr_type), POINTER :: s_matrix
TYPE(dft_control_type), POINTER :: dft_control
TYPE(linres_control_type), POINTER :: linres_control
TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
TYPE(pw_env_type), POINTER :: pw_env
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
TYPE(qs_rho_type), POINTER :: rho, rho1
TYPE(xtb_atom_type), POINTER :: xtb_kind
CALL timeset(routineN, handle)
CPASSERT(ASSOCIATED(p_env%kpp1_env))
CPASSERT(ASSOCIATED(p_env%kpp1))
rho1 => p_env%rho1
CPASSERT(ASSOCIATED(rho1))
CPASSERT(p_env%kpp1_env%ref_count > 0)
CALL get_qs_env(qs_env=qs_env, &
pw_env=pw_env, &
para_env=para_env, &
rho=rho, &
linres_control=linres_control, &
dft_control=dft_control)
CALL qs_rho_get(rho, rho_ao=rho_ao)
lr_triplet = linres_control%lr_triplet
CPASSERT(.NOT. lr_triplet)
nspins = SIZE(p_env%kpp1)
DO ispin = 1, nspins
CALL dbcsr_set(p_env%kpp1(ispin)%matrix, 0.0_dp)
ENDDO
IF (dft_control%qs_control%xtb_control%coulomb_interaction) THEN
! Mulliken charges
CALL get_qs_env(qs_env, particle_set=particle_set, matrix_s_kp=matrix_s)
natom = SIZE(particle_set)
CALL qs_rho_get(rho, rho_ao_kp=matrix_p)
CALL qs_rho_get(rho1, rho_ao_kp=matrix_p1)
ALLOCATE (mcharge(natom), charges(natom, 5))
ALLOCATE (mcharge1(natom), charges1(natom, 5))
charges = 0.0_dp
charges1 = 0.0_dp
CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set)
nkind = SIZE(atomic_kind_set)
CALL get_qs_kind_set(qs_kind_set, maxsgf=nsgf)
ALLOCATE (aocg(nsgf, natom))
aocg = 0.0_dp
ALLOCATE (aocg1(nsgf, natom))
aocg1 = 0.0_dp
p_matrix => matrix_p(:, 1)
s_matrix => matrix_s(1, 1)%matrix
CALL ao_charges(matrix_p, matrix_s, aocg, para_env)
CALL ao_charges(matrix_p1, matrix_s, aocg1, para_env)
DO ikind = 1, nkind
CALL get_atomic_kind(atomic_kind_set(ikind), natom=na)
CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_kind)
CALL get_xtb_atom_param(xtb_kind, natorb=natorb, lao=lao, occupation=occ)
DO iatom = 1, na
atom_a = atomic_kind_set(ikind)%atom_list(iatom)
charges(atom_a, :) = REAL(occ(:), KIND=dp)
DO is = 1, natorb
ns = lao(is) + 1
charges(atom_a, ns) = charges(atom_a, ns) - aocg(is, atom_a)
charges1(atom_a, ns) = charges1(atom_a, ns) - aocg1(is, atom_a)
END DO
END DO
END DO
DEALLOCATE (aocg, aocg1)
DO iatom = 1, natom
mcharge(iatom) = SUM(charges(iatom, :))
mcharge1(iatom) = SUM(charges1(iatom, :))
END DO
! Coulomb Kernel
CALL xtb_coulomb_hessian(qs_env, p_env%kpp1, charges1, mcharge1, mcharge)
!
DEALLOCATE (charges, mcharge, charges1, mcharge1)
END IF
CALL timestop(handle)
END SUBROUTINE apply_op_2_xtb
! **************************************************************************************************
!> \brief Update action of TDDFPT operator on trial vectors by adding exact-exchange term.
!> \param qs_env ...
!> \param p_env ...
!> \par History
!> * 11.2019 adapted from tddfpt_apply_hfx
! **************************************************************************************************
SUBROUTINE apply_hfx(qs_env, p_env)
TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env
CHARACTER(LEN=*), PARAMETER :: routineN = 'apply_hfx'
INTEGER :: handle
LOGICAL :: do_hfx
TYPE(dft_control_type), POINTER :: dft_control
TYPE(section_vals_type), POINTER :: hfx_section, input
CALL timeset(routineN, handle)
CALL get_qs_env(qs_env=qs_env, &
input=input, &
dft_control=dft_control)
hfx_section => section_vals_get_subs_vals(input, "DFT%XC%HF")
CALL section_vals_get(hfx_section, explicit=do_hfx)
IF (do_hfx) THEN
CALL apply_hfx_ao(qs_env, p_env)
END IF
CALL timestop(handle)
END SUBROUTINE apply_hfx
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param p_env ...
! **************************************************************************************************
SUBROUTINE apply_xc_admm(qs_env, p_env)
TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env
CHARACTER(len=*), PARAMETER :: routineN = 'apply_xc_admm'
INTEGER :: handle
TYPE(dft_control_type), POINTER :: dft_control
CALL timeset(routineN, handle)
CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
IF (dft_control%do_admm) THEN
CALL apply_xc_admm_ao(qs_env, p_env)
END IF
CALL timestop(handle)
END SUBROUTINE apply_xc_admm
! **************************************************************************************************
!> \brief projects first index of v onto the virtual subspace
!> \param v matrix to be projected
!> \param psi0 matrix with occupied orbitals
!> \param S_psi0 matrix containing product of metric and occupied orbitals
!> \param v ...
!> \param psi0 ...
!> \param S_psi0 ...
! **************************************************************************************************
SUBROUTINE preortho(v, psi0, S_psi0)
!v = (I-PS)v
@ -1378,8 +1060,6 @@ CONTAINS
END SUBROUTINE linres_read_restart
! **************************************************************************************************
! **************************************************************************************************
!> \brief ...
!> \param p_env ...

2
src/qs_linres_module.F
View file

@ -40,6 +40,7 @@ MODULE qs_linres_module
section_vals_get_subs_vals,&
section_vals_type,&
section_vals_val_get
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type,&
set_qs_env
@ -80,7 +81,6 @@ MODULE qs_linres_module
linres_control_release,&
linres_control_type,&
nmr_env_type
USE qs_mo_methods, ONLY: calculate_density_matrix
USE qs_mo_types, ONLY: mo_set_p_type
USE qs_p_env_methods, ONLY: p_env_create,&
p_env_psi0_changed

2
src/qs_mo_io.F
View file

@ -68,12 +68,12 @@ MODULE qs_mo_io
USE orbital_transformation_matrices, ONLY: orbtramat
USE particle_types, ONLY: particle_type
USE physcon, ONLY: evolt
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_dftb_types, ONLY: qs_dftb_atom_type
USE qs_dftb_utils, ONLY: get_dftb_atom_param
USE qs_kind_types, ONLY: get_qs_kind,&
get_qs_kind_set,&
qs_kind_type
USE qs_mo_methods, ONLY: calculate_density_matrix
USE qs_mo_occupation, ONLY: set_mo_occupation
USE qs_mo_types, ONLY: mo_set_p_type,&
mo_set_type

102
src/qs_mo_methods.F
View file

@ -21,10 +21,8 @@ MODULE qs_mo_methods
USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
copy_fm_to_dbcsr,&
cp_dbcsr_m_by_n_from_template,&
cp_dbcsr_plus_fm_fm_t,&
cp_dbcsr_sm_fm_multiply
USE cp_fm_basic_linalg, ONLY: cp_fm_column_scale,&
cp_fm_syrk,&
USE cp_fm_basic_linalg, ONLY: cp_fm_syrk,&
cp_fm_triangular_multiply
USE cp_fm_cholesky, ONLY: cp_fm_cholesky_decompose
USE cp_fm_diag, ONLY: choose_eigv_solver,&
@ -41,17 +39,20 @@ MODULE qs_mo_methods
USE cp_gemm_interface, ONLY: cp_gemm
USE cp_log_handling, ONLY: cp_logger_get_default_io_unit
USE cp_para_types, ONLY: cp_para_env_type
USE dbcsr_api, ONLY: &
dbcsr_copy, dbcsr_get_info, dbcsr_init_p, dbcsr_multiply, dbcsr_p_type, dbcsr_release, &
dbcsr_release_p, dbcsr_scale_by_vector, dbcsr_set, dbcsr_type, dbcsr_type_no_symmetry
USE dbcsr_api, ONLY: dbcsr_copy,&
dbcsr_get_info,&
dbcsr_init_p,&
dbcsr_multiply,&
dbcsr_p_type,&
dbcsr_release_p,&
dbcsr_type,&
dbcsr_type_no_symmetry
USE kinds, ONLY: dp
USE message_passing, ONLY: mp_max
USE physcon, ONLY: evolt
USE qs_mo_occupation, ONLY: set_mo_occupation
USE qs_mo_types, ONLY: get_mo_set,&
has_uniform_occupation,&
mo_set_p_type,&
mo_set_type
mo_set_p_type
USE scf_control_types, ONLY: scf_control_type
#include "./base/base_uses.f90"
@ -60,13 +61,9 @@ MODULE qs_mo_methods
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_mo_methods'
PUBLIC :: make_basis_simple, make_basis_cholesky, make_basis_sv, make_basis_sm, &
make_basis_lowdin, calculate_density_matrix, calculate_subspace_eigenvalues, &
make_basis_lowdin, calculate_subspace_eigenvalues, &
calculate_orthonormality, calculate_magnitude, make_mo_eig
INTERFACE calculate_density_matrix
MODULE PROCEDURE calculate_dm_sparse
END INTERFACE
INTERFACE calculate_subspace_eigenvalues
MODULE PROCEDURE subspace_eigenvalues_ks_fm
MODULE PROCEDURE subspace_eigenvalues_ks_dbcsr
@ -389,83 +386,6 @@ CONTAINS
END SUBROUTINE make_basis_simple
! **************************************************************************************************
!> \brief Calculate the density matrix
!> \param mo_set ...
!> \param density_matrix ...
!> \param use_dbcsr ...
!> \param retain_sparsity ...
!> \date 06.2002
!> \par History
!> - Fractional occupied orbitals (MK)
!> \author Joost VandeVondele
!> \version 1.0
! **************************************************************************************************
SUBROUTINE calculate_dm_sparse(mo_set, density_matrix, use_dbcsr, retain_sparsity)
TYPE(mo_set_type), POINTER :: mo_set
TYPE(dbcsr_type), POINTER :: density_matrix
LOGICAL, INTENT(IN), OPTIONAL :: use_dbcsr, retain_sparsity
CHARACTER(len=*), PARAMETER :: routineN = 'calculate_dm_sparse'
INTEGER :: handle
LOGICAL :: my_retain_sparsity, my_use_dbcsr
TYPE(cp_fm_type), POINTER :: fm_tmp
TYPE(dbcsr_type) :: dbcsr_tmp
CALL timeset(routineN, handle)
my_use_dbcsr = .FALSE.
IF (PRESENT(use_dbcsr)) my_use_dbcsr = use_dbcsr
my_retain_sparsity = .TRUE.
IF (PRESENT(retain_sparsity)) my_retain_sparsity = retain_sparsity
IF (my_use_dbcsr) THEN
IF (.NOT. ASSOCIATED(mo_set%mo_coeff_b)) THEN
CPABORT("mo_coeff_b NOT ASSOCIATED")
END IF
END IF
CALL dbcsr_set(density_matrix, 0.0_dp)
IF (has_uniform_occupation(mo_set=mo_set, last_mo=mo_set%homo)) THEN
IF (my_use_dbcsr) THEN
CALL dbcsr_multiply("N", "T", mo_set%maxocc, mo_set%mo_coeff_b, mo_set%mo_coeff_b, &
1.0_dp, density_matrix, retain_sparsity=my_retain_sparsity, &
last_k=mo_set%homo)
ELSE
CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=density_matrix, &
matrix_v=mo_set%mo_coeff, &
ncol=mo_set%homo, &
alpha=mo_set%maxocc)
END IF
ELSE
IF (my_use_dbcsr) THEN
CALL dbcsr_copy(dbcsr_tmp, mo_set%mo_coeff_b)
CALL dbcsr_scale_by_vector(dbcsr_tmp, mo_set%occupation_numbers(1:mo_set%homo), &
side='right')
CALL dbcsr_multiply("N", "T", 1.0_dp, mo_set%mo_coeff_b, dbcsr_tmp, &
1.0_dp, density_matrix, retain_sparsity=my_retain_sparsity, &
last_k=mo_set%homo)
CALL dbcsr_release(dbcsr_tmp)
ELSE
NULLIFY (fm_tmp)
CALL cp_fm_create(fm_tmp, mo_set%mo_coeff%matrix_struct)
CALL cp_fm_to_fm(mo_set%mo_coeff, fm_tmp)
CALL cp_fm_column_scale(fm_tmp, mo_set%occupation_numbers(1:mo_set%homo))
CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=density_matrix, &
matrix_v=mo_set%mo_coeff, &
matrix_g=fm_tmp, &
ncol=mo_set%homo, &
alpha=1.0_dp)
CALL cp_fm_release(fm_tmp)
END IF
END IF
CALL timestop(handle)
END SUBROUTINE calculate_dm_sparse
! **************************************************************************************************
!> \brief computes ritz values of a set of orbitals given a ks_matrix
!> rotates the orbitals into eigenstates depending on do_rotation

2
src/qs_mom_methods.F
View file

@ -33,7 +33,7 @@ MODULE qs_mom_methods
momtype_mom
USE input_section_types, ONLY: section_vals_type
USE kinds, ONLY: dp
USE qs_mo_methods, ONLY: calculate_density_matrix
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type,&
mo_set_type,&

13
src/qs_p_env_methods.F
View file

@ -154,8 +154,6 @@ CONTAINS
TYPE(pw_env_type), POINTER :: pw_env
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
! code
CALL timeset(routineN, handle)
NULLIFY (ao_mo_fm_pools, mo_mo_fm_pools, matrix_s, dft_control, para_env, blacs_env)
CALL get_qs_env(qs_env, &
@ -188,8 +186,17 @@ CONTAINS
p_env%ref_count = 1
last_p_env_id = last_p_env_id + 1
p_env%id_nr = last_p_env_id
p_env%iter = 0
p_env%new_preconditioner = .TRUE.
p_env%only_energy = .FALSE.
p_env%os_valid = .FALSE.
p_env%ls_count = 0
p_env%delta = 0.0_dp
p_env%gnorm = 0.0_dp
p_env%gnorm_old = 0.0_dp
p_env%etotal = 0.0_dp
p_env%gradient = 0.0_dp
CALL qs_rho_create(p_env%rho1)
CALL qs_rho_create(p_env%rho1_xc)
@ -448,7 +455,7 @@ CONTAINS
IF (dft_control%do_admm) THEN
IF (dft_control%admm_control%aux_exch_func /= do_admm_aux_exch_func_none) THEN
NULLIFY (ks_env, rho_g_aux, rho_r_aux, task_list)
NULLIFY (ks_env, rho1_ao, rho_g_aux, rho_r_aux, task_list)
CALL get_qs_env(qs_env, &
ks_env=ks_env, &

10
src/qs_p_env_types.F
View file

@ -18,6 +18,7 @@ MODULE qs_p_env_types
USE dbcsr_api, ONLY: dbcsr_p_type
USE hartree_local_types, ONLY: hartree_local_release,&
hartree_local_type
USE kinds, ONLY: dp
USE preconditioner_types, ONLY: destroy_preconditioner,&
preconditioner_type
USE qs_kpp1_env_types, ONLY: kpp1_release,&
@ -60,7 +61,7 @@ MODULE qs_p_env_types
TYPE qs_p_env_type
LOGICAL :: orthogonal_orbitals
INTEGER :: id_nr, ref_count
INTEGER :: id_nr, ref_count, iter
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: kpp1, kpp1_admm, p1, w1
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: p1_admm => NULL()
TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: m_epsilon, &
@ -82,6 +83,13 @@ MODULE qs_p_env_types
TYPE(preconditioner_type), DIMENSION(:), POINTER :: preconditioner
LOGICAL :: new_preconditioner
!factors
REAL(KIND=dp) :: delta, gnorm, gnorm_cross, gnorm_old, etotal, gradient
!line search
INTEGER :: ls_count
REAL(KIND=dp) :: ls_pos(53), ls_energy(53), ls_grad(53)
LOGICAL :: only_energy, os_valid
END TYPE qs_p_env_type
! **************************************************************************************************

459
src/qs_rho_methods.F
View file

@ -20,9 +20,11 @@ MODULE qs_rho_methods
dbcsr_deallocate_matrix_set
USE cp_log_handling, ONLY: cp_to_string
USE cp_para_types, ONLY: cp_para_env_type
USE dbcsr_api, ONLY: dbcsr_copy,&
USE dbcsr_api, ONLY: dbcsr_add,&
dbcsr_copy,&
dbcsr_create,&
dbcsr_p_type,&
dbcsr_scale,&
dbcsr_set,&
dbcsr_type,&
dbcsr_type_symmetric
@ -71,7 +73,8 @@ MODULE qs_rho_methods
LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_rho_methods'
PUBLIC :: qs_rho_update_rho, qs_rho_rebuild, duplicate_rho_type
PUBLIC :: qs_rho_update_rho, qs_rho_rebuild, qs_rho_copy, qs_rho_scale_and_add
PUBLIC :: duplicate_rho_type
CONTAINS
@ -553,6 +556,458 @@ CONTAINS
END SUBROUTINE qs_rho_update_rho
! **************************************************************************************************
!> \brief Allocate a density structure and fill it with data from an input structure
!> SIZE(rho_input) == mspin == 1 direct copy
!> SIZE(rho_input) == mspin == 2 direct copy of alpha and beta spin
!> SIZE(rho_input) == 1 AND mspin == 2 copy rho/2 into alpha and beta spin
!> \param rho_input ...
!> \param rho_output ...
!> \param auxbas_pw_pool ...
!> \param mspin ...
! **************************************************************************************************
SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin)
TYPE(qs_rho_type), POINTER :: rho_input, rho_output
TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
INTEGER, INTENT(IN) :: mspin
CHARACTER(len=*), PARAMETER :: routineN = 'qs_rho_copy', routineP = moduleN//':'//routineN
INTEGER :: handle, i, ii, nspins, rebuild_each_in
LOGICAL :: drho_g_valid_in, drho_r_valid_in, rho_g_valid_in, rho_r_valid_in, soft_valid_in, &
tau_g_valid_in, tau_r_valid_in
REAL(KIND=dp) :: ospin
REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho_g_in, tot_rho_g_out, &
tot_rho_r_in, tot_rho_r_out
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im_in, rho_ao_in, rho_ao_out
TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp_in
TYPE(pw_p_type), DIMENSION(:), POINTER :: drho_g_in, drho_g_out, drho_r_in, drho_r_out, &
rho_g_in, rho_g_out, rho_r_in, rho_r_out, tau_g_in, tau_g_out, tau_r_in, tau_r_out
TYPE(pw_p_type), POINTER :: rho_r_sccs_in, rho_r_sccs_out
CALL timeset(routineN, handle)
CPASSERT(ASSOCIATED(rho_input))
CPASSERT(ASSOCIATED(rho_output))
CPASSERT(mspin == 1 .OR. mspin == 2)
ospin = 1._dp/REAL(mspin, KIND=dp)
CALL qs_rho_clear(rho_output)
NULLIFY (rho_ao_in, rho_ao_kp_in, rho_ao_im_in, rho_r_in, rho_g_in, drho_r_in, &
drho_g_in, tau_r_in, tau_g_in, tot_rho_r_in, tot_rho_g_in, rho_r_sccs_in)
CALL qs_rho_get(rho_input, &
rho_ao=rho_ao_in, &
rho_ao_kp=rho_ao_kp_in, &
rho_ao_im=rho_ao_im_in, &
rho_r=rho_r_in, &
rho_g=rho_g_in, &
drho_r=drho_r_in, &
drho_g=drho_g_in, &
tau_r=tau_r_in, &
tau_g=tau_g_in, &
tot_rho_r=tot_rho_r_in, &
tot_rho_g=tot_rho_g_in, &
rho_g_valid=rho_g_valid_in, &
rho_r_valid=rho_r_valid_in, &
drho_g_valid=drho_g_valid_in, &
drho_r_valid=drho_r_valid_in, &
tau_r_valid=tau_r_valid_in, &
tau_g_valid=tau_g_valid_in, &
rho_r_sccs=rho_r_sccs_in, &
soft_valid=soft_valid_in, &
rebuild_each=rebuild_each_in)
NULLIFY (rho_ao_out, rho_r_out, rho_g_out, drho_r_out, &
drho_g_out, tau_r_out, tau_g_out, tot_rho_r_out, tot_rho_g_out, rho_r_sccs_out)
! rho_ao
IF (ASSOCIATED(rho_ao_in)) THEN
nspins = SIZE(rho_ao_in)
CPASSERT(mspin >= nspins)
CALL dbcsr_allocate_matrix_set(rho_ao_out, mspin)
CALL qs_rho_set(rho_output, rho_ao=rho_ao_out)
IF (mspin > nspins) THEN
DO i = 1, mspin
ALLOCATE (rho_ao_out(i)%matrix)
CALL dbcsr_copy(rho_ao_out(i)%matrix, rho_ao_in(1)%matrix, name="RHO copy")
CALL dbcsr_scale(rho_ao_out(i)%matrix, ospin)
END DO
ELSE
DO i = 1, nspins
ALLOCATE (rho_ao_out(i)%matrix)
CALL dbcsr_copy(rho_ao_out(i)%matrix, rho_ao_in(i)%matrix, name="RHO copy")
END DO
END IF
END IF
! rho_ao_kp
! only for non-kp, we could probably just copy this pointer, should work also for non-kp?
!IF (ASSOCIATED(rho_ao_kp_in)) THEN
! CPABORT("Copy not available")
!END IF
! rho_ao_im
IF (ASSOCIATED(rho_ao_im_in)) THEN
CPABORT("Copy not available")
END IF
! rho_r
IF (ASSOCIATED(rho_r_in)) THEN
nspins = SIZE(rho_r_in)
CPASSERT(mspin >= nspins)
ALLOCATE (rho_r_out(mspin))
CALL qs_rho_set(rho_output, rho_r=rho_r_out)
IF (mspin > nspins) THEN
DO i = 1, mspin
CALL pw_pool_create_pw(auxbas_pw_pool, rho_r_out(i)%pw, &
use_data=REALDATA3D, in_space=REALSPACE)
rho_r_out(i)%pw%cr3d(:, :, :) = rho_r_in(1)%pw%cr3d(:, :, :)*ospin
END DO
ELSE
DO i = 1, nspins
CALL pw_pool_create_pw(auxbas_pw_pool, rho_r_out(i)%pw, &
use_data=REALDATA3D, in_space=REALSPACE)
rho_r_out(i)%pw%cr3d(:, :, :) = rho_r_in(i)%pw%cr3d(:, :, :)
END DO
END IF
END IF
! rho_g
IF (ASSOCIATED(rho_g_in)) THEN
nspins = SIZE(rho_g_in)
CPASSERT(mspin >= nspins)
ALLOCATE (rho_g_out(mspin))
CALL qs_rho_set(rho_output, rho_g=rho_g_out)
IF (mspin > nspins) THEN
DO i = 1, mspin
CALL pw_pool_create_pw(auxbas_pw_pool, rho_g_out(i)%pw, &
use_data=COMPLEXDATA1D, &
in_space=RECIPROCALSPACE)
rho_g_out(i)%pw%cc(:) = rho_g_in(1)%pw%cc(:)*ospin
END DO
ELSE
DO i = 1, nspins
CALL pw_pool_create_pw(auxbas_pw_pool, rho_g_out(i)%pw, &
use_data=COMPLEXDATA1D, &
in_space=RECIPROCALSPACE)
rho_g_out(i)%pw%cc(:) = rho_g_in(i)%pw%cc(:)
END DO
END IF
END IF
! SCCS
IF (ASSOCIATED(rho_r_sccs_in)) THEN
CALL qs_rho_set(rho_output, rho_r_sccs=rho_r_sccs_out)
CALL pw_pool_create_pw(auxbas_pw_pool, rho_r_sccs_out%pw, &
in_space=REALSPACE, &
use_data=REALDATA3D)
rho_r_sccs_out%pw%cr3d(:, :, :) = rho_r_sccs_in%pw%cr3d(:, :, :)
END IF
! drho_r
IF (ASSOCIATED(drho_r_in)) THEN
nspins = SIZE(drho_r_in)
CPASSERT(mspin >= nspins)
ALLOCATE (drho_r_out(3*mspin))
CALL qs_rho_set(rho_output, drho_r=drho_r_out)
IF (mspin > nspins) THEN
DO i = 1, 3*mspin
ii = (i + 1)/2
CALL pw_pool_create_pw(auxbas_pw_pool, drho_r_out(i)%pw, &
use_data=REALDATA3D, in_space=REALSPACE)
drho_r_out(i)%pw%cr3d(:, :, :) = drho_r_in(ii)%pw%cr3d(:, :, :)*ospin
END DO
ELSE
DO i = 1, 3*nspins
CALL pw_pool_create_pw(auxbas_pw_pool, drho_r_out(i)%pw, &
use_data=REALDATA3D, in_space=REALSPACE)
drho_r_out(i)%pw%cr3d(:, :, :) = drho_r_in(i)%pw%cr3d(:, :, :)
END DO
END IF
END IF
! drho_g
IF (ASSOCIATED(drho_g_in)) THEN
nspins = SIZE(drho_g_in)
CPASSERT(mspin >= nspins)
ALLOCATE (drho_g_out(3*mspin))
CALL qs_rho_set(rho_output, drho_g=drho_g_out)
IF (mspin > nspins) THEN
DO i = 1, 3*mspin
ii = (i + 1)/2
CALL pw_pool_create_pw(auxbas_pw_pool, drho_g_out(i)%pw, &
use_data=COMPLEXDATA1D, &
in_space=RECIPROCALSPACE)
drho_g_out(i)%pw%cc(:) = drho_g_in(ii)%pw%cc(:)*ospin
END DO
ELSE
DO i = 1, 3*nspins
CALL pw_pool_create_pw(auxbas_pw_pool, drho_g_out(i)%pw, &
use_data=COMPLEXDATA1D, &
in_space=RECIPROCALSPACE)
drho_g_out(i)%pw%cc(:) = drho_g_in(i)%pw%cc(:)
END DO
END IF
END IF
! tau_r
IF (ASSOCIATED(tau_r_in)) THEN
nspins = SIZE(tau_r_in)
CPASSERT(mspin >= nspins)
ALLOCATE (tau_r_out(mspin))
CALL qs_rho_set(rho_output, tau_r=tau_r_out)
IF (mspin > nspins) THEN
DO i = 1, mspin
CALL pw_pool_create_pw(auxbas_pw_pool, tau_r_out(i)%pw, &
use_data=REALDATA3D, in_space=REALSPACE)
tau_r_out(i)%pw%cr3d(:, :, :) = tau_r_in(1)%pw%cr3d(:, :, :)*ospin
END DO
ELSE
DO i = 1, nspins
CALL pw_pool_create_pw(auxbas_pw_pool, tau_r_out(i)%pw, &
use_data=REALDATA3D, in_space=REALSPACE)
tau_r_out(i)%pw%cr3d(:, :, :) = tau_r_in(i)%pw%cr3d(:, :, :)
END DO
END IF
END IF
! tau_g
IF (ASSOCIATED(tau_g_in)) THEN
nspins = SIZE(tau_g_in)
CPASSERT(mspin >= nspins)
ALLOCATE (tau_g_out(mspin))
CALL qs_rho_set(rho_output, tau_g=tau_g_out)
IF (mspin > nspins) THEN
DO i = 1, mspin
CALL pw_pool_create_pw(auxbas_pw_pool, tau_g_out(i)%pw, &
use_data=COMPLEXDATA1D, &
in_space=RECIPROCALSPACE)
tau_g_out(i)%pw%cc(:) = tau_g_in(1)%pw%cc(:)*ospin
END DO
ELSE
DO i = 1, nspins
CALL pw_pool_create_pw(auxbas_pw_pool, tau_g_out(i)%pw, &
use_data=COMPLEXDATA1D, &
in_space=RECIPROCALSPACE)
tau_g_out(i)%pw%cc(:) = tau_g_in(i)%pw%cc(:)
END DO
END IF
END IF
! tot_rho_r
IF (ASSOCIATED(tot_rho_r_in)) THEN
nspins = SIZE(tot_rho_r_in)
CPASSERT(mspin >= nspins)
ALLOCATE (tot_rho_r_out(mspin))
CALL qs_rho_set(rho_output, tot_rho_r=tot_rho_r_out)
IF (mspin > nspins) THEN
DO i = 1, mspin
tot_rho_r_out(i) = tot_rho_r_in(1)*ospin
END DO
ELSE
DO i = 1, nspins
tot_rho_r_out(i) = tot_rho_r_in(i)
END DO
END IF
END IF
! tot_rho_g
IF (ASSOCIATED(tot_rho_g_in)) THEN
nspins = SIZE(tot_rho_g_in)
CPASSERT(mspin >= nspins)
ALLOCATE (tot_rho_g_out(mspin))
CALL qs_rho_set(rho_output, tot_rho_g=tot_rho_g_out)
IF (mspin > nspins) THEN
DO i = 1, mspin
tot_rho_g_out(i) = tot_rho_g_in(1)*ospin
END DO
ELSE
DO i = 1, nspins
tot_rho_g_out(i) = tot_rho_g_in(i)
END DO
END IF
END IF
CALL qs_rho_set(rho_output, &
rho_g_valid=rho_g_valid_in, &
rho_r_valid=rho_r_valid_in, &
drho_g_valid=drho_g_valid_in, &
drho_r_valid=drho_r_valid_in, &
tau_r_valid=tau_r_valid_in, &
tau_g_valid=tau_g_valid_in, &
soft_valid=soft_valid_in, &
rebuild_each=rebuild_each_in)
CALL timestop(handle)
END SUBROUTINE qs_rho_copy
! **************************************************************************************************
!> \brief rhoa = alpha*rhoa+beta*rhob
!> \param rhoa ...
!> \param rhob ...
!> \param alpha ...
!> \param beta ...
! **************************************************************************************************
SUBROUTINE qs_rho_scale_and_add(rhoa, rhob, alpha, beta)
TYPE(qs_rho_type), POINTER :: rhoa, rhob
REAL(KIND=dp), INTENT(IN) :: alpha, beta
CHARACTER(len=*), PARAMETER :: routineN = 'qs_rho_scale_and_add', &
routineP = moduleN//':'//routineN
INTEGER :: handle, i, ndims, nspina, nspinb, nspins
REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho_g_a, tot_rho_g_b, tot_rho_r_a, &
tot_rho_r_b
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_a, rho_ao_b, rho_ao_im_a, &
rho_ao_im_b
TYPE(pw_p_type), DIMENSION(:), POINTER :: drho_g_a, drho_g_b, drho_r_a, drho_r_b, &
rho_g_a, rho_g_b, rho_r_a, rho_r_b, &
tau_g_a, tau_g_b, tau_r_a, tau_r_b
TYPE(pw_p_type), POINTER :: rho_r_sccs_a, rho_r_sccs_b
CALL timeset(routineN, handle)
CPASSERT(ASSOCIATED(rhoa))
CPASSERT(ASSOCIATED(rhob))
NULLIFY (rho_ao_a, rho_ao_im_a, rho_r_a, rho_g_a, drho_r_a, &
drho_g_a, tau_r_a, tau_g_a, tot_rho_r_a, tot_rho_g_a, rho_r_sccs_a)
CALL qs_rho_get(rhoa, &
rho_ao=rho_ao_a, &
rho_ao_im=rho_ao_im_a, &
rho_r=rho_r_a, &
rho_g=rho_g_a, &
drho_r=drho_r_a, &
drho_g=drho_g_a, &
tau_r=tau_r_a, &
tau_g=tau_g_a, &
tot_rho_r=tot_rho_r_a, &
tot_rho_g=tot_rho_g_a, &
rho_r_sccs=rho_r_sccs_a)
NULLIFY (rho_ao_b, rho_ao_im_b, rho_r_b, rho_g_b, drho_r_b, &
drho_g_b, tau_r_b, tau_g_b, tot_rho_r_b, tot_rho_g_b, rho_r_sccs_b)
CALL qs_rho_get(rhob, &
rho_ao=rho_ao_b, &
rho_ao_im=rho_ao_im_b, &
rho_r=rho_r_b, &
rho_g=rho_g_b, &
drho_r=drho_r_b, &
drho_g=drho_g_b, &
tau_r=tau_r_b, &
tau_g=tau_g_b, &
tot_rho_r=tot_rho_r_b, &
tot_rho_g=tot_rho_g_b, &
rho_r_sccs=rho_r_sccs_b)
! rho_ao
IF (ASSOCIATED(rho_ao_a) .AND. ASSOCIATED(rho_ao_b)) THEN
nspina = SIZE(rho_ao_a)
nspinb = SIZE(rho_ao_b)
nspins = MIN(nspina, nspinb)
DO i = 1, nspins
CALL dbcsr_add(rho_ao_a(i)%matrix, rho_ao_b(i)%matrix, alpha, beta)
END DO
END IF
! rho_ao_im
IF (ASSOCIATED(rho_ao_im_a) .AND. ASSOCIATED(rho_ao_im_b)) THEN
CPABORT("Add not available")
END IF
! rho_r
IF (ASSOCIATED(rho_r_a) .AND. ASSOCIATED(rho_r_b)) THEN
nspina = SIZE(rho_ao_a)
nspinb = SIZE(rho_ao_b)
nspins = MIN(nspina, nspinb)
DO i = 1, nspins
rho_r_a(i)%pw%cr3d(:, :, :) = alpha*rho_r_a(i)%pw%cr3d(:, :, :) + beta*rho_r_b(i)%pw%cr3d(:, :, :)
END DO
END IF
! rho_g
IF (ASSOCIATED(rho_g_a) .AND. ASSOCIATED(rho_g_b)) THEN
nspina = SIZE(rho_ao_a)
nspinb = SIZE(rho_ao_b)
nspins = MIN(nspina, nspinb)
DO i = 1, nspins
rho_g_a(i)%pw%cc(:) = alpha*rho_g_a(i)%pw%cc(:) + beta*rho_g_b(i)%pw%cc(:)
END DO
END IF
! SCCS
IF (ASSOCIATED(rho_r_sccs_a) .AND. ASSOCIATED(rho_r_sccs_b)) THEN
rho_r_sccs_a%pw%cr3d(:, :, :) = alpha*rho_r_sccs_a%pw%cr3d(:, :, :) + beta*rho_r_sccs_b%pw%cr3d(:, :, :)
END IF
! drho_r
IF (ASSOCIATED(drho_r_a) .AND. ASSOCIATED(drho_r_b)) THEN
ndims = SIZE(drho_r_a)
CPASSERT(ndims == SIZE(drho_r_b)) ! not implemented
DO i = 1, ndims
drho_r_a(i)%pw%cr3d(:, :, :) = alpha*drho_r_a(i)%pw%cr3d(:, :, :) + beta*drho_r_b(i)%pw%cr3d(:, :, :)
END DO
END IF
! drho_g
IF (ASSOCIATED(drho_g_a) .AND. ASSOCIATED(drho_g_b)) THEN
ndims = SIZE(drho_g_a)
CPASSERT(ndims == SIZE(drho_r_b)) ! not implemented
DO i = 1, ndims
drho_g_a(i)%pw%cc(:) = alpha*drho_g_a(i)%pw%cc(:) + beta*drho_g_b(i)%pw%cc(:)
END DO
END IF
! tau_r
IF (ASSOCIATED(tau_r_a) .AND. ASSOCIATED(tau_r_b)) THEN
nspina = SIZE(rho_ao_a)
nspinb = SIZE(rho_ao_b)
nspins = MIN(nspina, nspinb)
DO i = 1, nspins
tau_r_a(i)%pw%cr3d(:, :, :) = alpha*tau_r_a(i)%pw%cr3d(:, :, :) + beta*tau_r_b(i)%pw%cr3d(:, :, :)
END DO
END IF
! tau_g
IF (ASSOCIATED(tau_g_a) .AND. ASSOCIATED(tau_g_b)) THEN
nspina = SIZE(rho_ao_a)
nspinb = SIZE(rho_ao_b)
nspins = MIN(nspina, nspinb)
DO i = 1, nspins
tau_g_a(i)%pw%cc(:) = alpha*tau_g_a(i)%pw%cc(:) + beta*tau_g_b(i)%pw%cc(:)
END DO
END IF
! tot_rho_r
IF (ASSOCIATED(tot_rho_r_a) .AND. ASSOCIATED(tot_rho_r_b)) THEN
nspina = SIZE(rho_ao_a)
nspinb = SIZE(rho_ao_b)
nspins = MIN(nspina, nspinb)
DO i = 1, nspins
tot_rho_r_a(i) = alpha*tot_rho_r_a(i) + beta*tot_rho_r_b(i)
END DO
END IF
! tot_rho_g
IF (ASSOCIATED(tot_rho_g_a) .AND. ASSOCIATED(tot_rho_g_b)) THEN
nspina = SIZE(rho_ao_a)
nspinb = SIZE(rho_ao_b)
nspins = MIN(nspina, nspinb)
DO i = 1, nspins
tot_rho_g_a(i) = alpha*tot_rho_g_a(i) + beta*tot_rho_g_b(i)
END DO
END IF
CALL timestop(handle)
END SUBROUTINE qs_rho_scale_and_add
! **************************************************************************************************
!> \brief Duplicates a pointer physically
!> \param rho_input The rho structure to be duplicated

2
src/qs_rho_types.F
View file

@ -68,7 +68,7 @@ MODULE qs_rho_types
TYPE qs_rho_type
PRIVATE
TYPE(kpoint_transitional_type) :: rho_ao
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im => Null()
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im => Null()
TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_g => Null(), &
rho_r => Null(), &
drho_g => Null(), &

4
src/qs_scf.F
View file

@ -112,6 +112,7 @@ MODULE qs_scf
restart_inverse_jacobian
USE qs_cdft_types, ONLY: cdft_control_type
USE qs_charges_types, ONLY: qs_charges_type
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_density_mixing_types, ONLY: gspace_mixing_nr
USE qs_diis, ONLY: qs_diis_b_clear,&
qs_diis_b_create
@ -125,8 +126,7 @@ MODULE qs_scf
USE qs_ks_types, ONLY: qs_ks_did_change,&
qs_ks_env_type
USE qs_mo_io, ONLY: write_mo_set_to_restart
USE qs_mo_methods, ONLY: calculate_density_matrix,&
make_basis_simple,&
USE qs_mo_methods, ONLY: make_basis_simple,&
make_basis_sm
USE qs_mo_occupation, ONLY: set_mo_occupation
USE qs_mo_types, ONLY: deallocate_mo_set,&

4
src/qs_scf_diagonalization.F
View file

@ -70,6 +70,7 @@ MODULE qs_scf_diagonalization
m_walltime
USE preconditioner, ONLY: prepare_preconditioner,&
restart_preconditioner
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_density_mixing_types, ONLY: direct_mixing_nr,&
gspace_mixing_nr
USE qs_diis, ONLY: qs_diis_b_step
@ -86,8 +87,7 @@ MODULE qs_scf_diagonalization
mixing_allocate,&
mixing_init,&
self_consistency_check
USE qs_mo_methods, ONLY: calculate_density_matrix,&
calculate_subspace_eigenvalues
USE qs_mo_methods, ONLY: calculate_subspace_eigenvalues
USE qs_mo_occupation, ONLY: set_mo_occupation
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type

2
src/qs_scf_loop_utils.F
View file

@ -20,6 +20,7 @@ MODULE qs_scf_loop_utils
USE kinds, ONLY: default_string_length,&
dp
USE kpoint_types, ONLY: kpoint_type
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_density_mixing_types, ONLY: broyden_mixing_new_nr,&
broyden_mixing_nr,&
direct_mixing_nr,&
@ -35,7 +36,6 @@ MODULE qs_scf_loop_utils
USE qs_ks_types, ONLY: qs_ks_did_change,&
qs_ks_env_type
USE qs_mixing_utils, ONLY: self_consistency_check
USE qs_mo_methods, ONLY: calculate_density_matrix
USE qs_mo_occupation, ONLY: set_mo_occupation
USE qs_mo_types, ONLY: mo_set_p_type
USE qs_mom_methods, ONLY: do_mom_diag

5
src/qs_scf_output.F
View file

@ -752,6 +752,11 @@ CONTAINS
WRITE (UNIT=output_unit, FMT="(T3,A,T56,F25.14)") &
"Mulliken restraint energy: ", energy%mulliken
END IF
IF (qs_env%excited_state) THEN
IF (energy%excited_state /= 0.0_dp) &
WRITE (UNIT=output_unit, FMT="(T3,A,T56,F25.14)") &
"Excited State energy: ", energy%excited_state
END IF
IF (dft_control%qs_control%semi_empirical) THEN
WRITE (UNIT=output_unit, FMT="(/,(T3,A,T56,F25.14))") &
"Total energy [eV]: ", energy%total*evolt

32
src/qs_scf_post_gpw.F
View file

@ -52,7 +52,8 @@ MODULE qs_scf_post_gpw
cp_print_key_unit_nr
USE cp_para_types, ONLY: cp_para_env_type
USE cp_realspace_grid_cube, ONLY: cp_pw_to_cube
USE dbcsr_api, ONLY: dbcsr_p_type,&
USE dbcsr_api, ONLY: dbcsr_add,&
dbcsr_p_type,&
dbcsr_type
USE dct, ONLY: pw_shrink
USE et_coupling_types, ONLY: set_et_coupling_type
@ -184,6 +185,7 @@ MODULE qs_scf_post_gpw
mpole_rho_atom,&
rho0_mpole_type
USE qs_rho_atom_types, ONLY: rho_atom_type
USE qs_rho_methods, ONLY: qs_rho_update_rho
USE qs_rho_types, ONLY: qs_rho_get,&
qs_rho_type
USE qs_scf_csr_write, ONLY: write_ks_matrix_csr,&
@ -248,7 +250,7 @@ CONTAINS
nhomo, nlumo, nlumo_stm, nlumo_tddft, &
nlumos, nmo, output_unit, unit_nr
INTEGER, DIMENSION(:, :, :), POINTER :: marked_states
LOGICAL :: check_write, compute_lumos, do_homo, do_kpoints, do_mo_cubes, do_stm, &
LOGICAL :: check_write, compute_lumos, do_homo, do_kpoints, do_mo_cubes, do_mp2, do_stm, &
do_wannier_cubes, has_homo, has_lumo, loc_explicit, loc_print_explicit, my_localized_wfn, &
p_loc, p_loc_homo, p_loc_lumo
REAL(dp) :: e_kin
@ -262,7 +264,8 @@ CONTAINS
mo_loc_history, occupied_orbs, unoccupied_orbs, unoccupied_orbs_stm
TYPE(cp_fm_type), POINTER :: mo_coeff
TYPE(cp_logger_type), POINTER :: logger
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_s, mo_derivs
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_p_mp2, matrix_s, &
mo_derivs
TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: kinetic_m, rho_ao
TYPE(dft_control_type), POINTER :: dft_control
TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos
@ -289,6 +292,7 @@ CONTAINS
output_unit = cp_logger_get_default_io_unit(logger)
! Print out the type of wavefunction to distinguish between SCF and post-SCF
do_mp2 = .FALSE.
IF (PRESENT(wf_type)) THEN
IF (output_unit > 0) THEN
WRITE (UNIT=output_unit, FMT='(/,(T1,A))') REPEAT("-", 40)
@ -335,8 +339,17 @@ CONTAINS
CALL qs_rho_get(rho, rho_ao_kp=rho_ao)
! In MP2 case update the Hartree potential
IF (ASSOCIATED(qs_env%mp2_env)) CALL update_hartree_with_mp2(rho, qs_env)
IF (do_mp2) THEN
! Get the HF+MP2 density
CALL get_qs_env(qs_env, matrix_p_mp2=matrix_p_mp2)
DO ispin = 1, dft_control%nspins
CALL dbcsr_add(rho_ao(ispin, 1)%matrix, matrix_p_mp2(ispin)%matrix, 1.0_dp, 1.0_dp)
END DO
CALL qs_rho_update_rho(rho, qs_env=qs_env)
CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.TRUE.)
! In MP2 case update the Hartree potential
CALL update_hartree_with_mp2(rho, qs_env)
END IF
! **** the kinetic energy
IF (cp_print_key_should_output(logger%iter_info, input, &
@ -733,6 +746,15 @@ CONTAINS
! Do active space calculation
CALL active_space_main(input, logger, qs_env)
IF (do_mp2) THEN
! Get everything back
DO ispin = 1, dft_control%nspins
CALL dbcsr_add(rho_ao(ispin, 1)%matrix, matrix_p_mp2(ispin)%matrix, 1.0_dp, -1.0_dp)
END DO
CALL qs_rho_update_rho(rho, qs_env=qs_env)
CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.TRUE.)
END IF
CALL timestop(handle)
END SUBROUTINE scf_post_calculation_gpw

58
src/qs_tddfpt2_eigensolver.F
View file

@ -30,6 +30,7 @@ MODULE qs_tddfpt2_eigensolver
dbcsr_p_type,&
dbcsr_type
USE input_constants, ONLY: tddfpt_kernel_full,&
tddfpt_kernel_none,&
tddfpt_kernel_stda
USE input_section_types, ONLY: section_vals_type
USE kinds, ONLY: dp,&
@ -40,7 +41,8 @@ MODULE qs_tddfpt2_eigensolver
USE physcon, ONLY: evolt
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
USE qs_kernel_types, ONLY: full_kernel_env_type
USE qs_kernel_types, ONLY: full_kernel_env_type,&
kernel_env_type
USE qs_scf_methods, ONLY: eigensolver
USE qs_tddfpt2_fhxc, ONLY: fhxc_kernel,&
stda_kernel
@ -48,8 +50,7 @@ MODULE qs_tddfpt2_eigensolver
tddfpt_apply_hfx
USE qs_tddfpt2_restart, ONLY: tddfpt_write_restart
USE qs_tddfpt2_subgroups, ONLY: tddfpt_subgroup_env_type
USE qs_tddfpt2_types, ONLY: kernel_env_type,&
tddfpt_ground_state_mos,&
USE qs_tddfpt2_types, ONLY: tddfpt_ground_state_mos,&
tddfpt_work_matrices
USE qs_tddfpt2_utils, ONLY: tddfpt_total_number_of_states
#include "./base/base_uses.f90"
@ -290,7 +291,6 @@ CONTAINS
!> in primary basis set
!> \param gs_mos molecular orbitals optimised for the ground state
!> \param tddfpt_control control section for tddfpt
!> \param do_hfx flag that activates computation of exact-exchange terms
!> \param matrix_ks Kohn-Sham matrix
!> \param qs_env Quickstep environment
!> \param kernel_env kernel environment
@ -301,13 +301,12 @@ CONTAINS
!> * 03.2017 refactored [Sergey Chulkov]
! **************************************************************************************************
SUBROUTINE tddfpt_compute_Aop_evects(Aop_evects, evects, S_evects, gs_mos, tddfpt_control, &
do_hfx, matrix_ks, qs_env, kernel_env, &
matrix_ks, qs_env, kernel_env, &
sub_env, work_matrices)
TYPE(cp_fm_p_type), DIMENSION(:, :), INTENT(in) :: Aop_evects, evects, S_evects
TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
INTENT(in) :: gs_mos
TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
LOGICAL, INTENT(in) :: do_hfx
TYPE(dbcsr_p_type), DIMENSION(:), INTENT(in) :: matrix_ks
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(kernel_env_type), INTENT(in) :: kernel_env
@ -318,7 +317,7 @@ CONTAINS
INTEGER :: handle, ispin, ivect, nspins, nvects
INTEGER, DIMENSION(maxspins) :: nmo_occ
LOGICAL :: do_admm, is_rks_triplets, is_stda
LOGICAL :: do_admm, do_hfx, is_rks_triplets
TYPE(cp_para_env_type), POINTER :: para_env
TYPE(full_kernel_env_type), POINTER :: full_kernel_env, kernel_env_admm_aux
@ -328,7 +327,8 @@ CONTAINS
nspins = SIZE(evects, 1)
nvects = SIZE(evects, 2)
do_admm = ASSOCIATED(sub_env%admm_A)
do_hfx = tddfpt_control%do_hfx
do_admm = tddfpt_control%do_admm
IF (do_admm) THEN
kernel_env_admm_aux => kernel_env%admm_kernel
ELSE
@ -362,14 +362,20 @@ CONTAINS
IF (tddfpt_control%kernel == tddfpt_kernel_full) THEN
! full TDDFPT kernel
CALL fhxc_kernel(Aop_evects, evects, is_rks_triplets, do_hfx, qs_env, &
full_kernel_env, kernel_env_admm_aux, sub_env, work_matrices)
is_stda = .FALSE.
CALL fhxc_kernel(Aop_evects, evects, is_rks_triplets, do_hfx, do_admm, qs_env, &
full_kernel_env, kernel_env_admm_aux, sub_env, work_matrices, &
tddfpt_control%admm_symm)
ELSE IF (tddfpt_control%kernel == tddfpt_kernel_stda) THEN
! sTDA kernel
CALL stda_kernel(Aop_evects, evects, is_rks_triplets, qs_env, tddfpt_control%stda_control, &
kernel_env%stda_kernel, sub_env, work_matrices)
is_stda = .TRUE.
ELSE IF (tddfpt_control%kernel == tddfpt_kernel_none) THEN
! No kernel
DO ivect = 1, nvects
DO ispin = 1, nspins
CALL cp_fm_set_all(Aop_evects(ispin, ivect)%matrix, 0.0_dp)
END DO
END DO
ELSE
CPABORT("Kernel type not implemented")
END IF
@ -387,10 +393,21 @@ CONTAINS
CALL tddfpt_apply_energy_diff(Aop_evects=Aop_evects, evects=evects, S_evects=S_evects, &
gs_mos=gs_mos, matrix_ks=matrix_ks)
IF (do_hfx .AND. .NOT. is_stda) THEN
CALL tddfpt_apply_hfx(Aop_evects=Aop_evects, evects=evects, gs_mos=gs_mos, do_admm=do_admm, &
qs_env=qs_env, work_rho_ia_ao=work_matrices%hfx_rho_ao, &
work_hmat=work_matrices%hfx_hmat, wfm_rho_orb=work_matrices%hfx_fm_ao_ao)
IF (do_hfx) THEN
IF (tddfpt_control%kernel == tddfpt_kernel_full) THEN
! full TDDFPT kernel
CALL tddfpt_apply_hfx(Aop_evects=Aop_evects, evects=evects, gs_mos=gs_mos, do_admm=do_admm, &
qs_env=qs_env, work_rho_ia_ao=work_matrices%hfx_rho_ao, &
work_hmat=work_matrices%hfx_hmat, wfm_rho_orb=work_matrices%hfx_fm_ao_ao)
ELSE IF (tddfpt_control%kernel == tddfpt_kernel_stda) THEN
! sTDA kernel
! special treatment of HFX term
ELSE IF (tddfpt_control%kernel == tddfpt_kernel_none) THEN
! No kernel
! drop kernel contribution of HFX term
ELSE
CPABORT("Kernel type not implemented")
END IF
END IF
END IF
@ -615,7 +632,6 @@ CONTAINS
!> \param evals TDDFPT eigenvalues (modified on exit)
!> \param S_evects cached matrix product S * evects (modified on exit)
!> \param gs_mos molecular orbitals optimised for the ground state
!> \param do_hfx flag that activates computation of exact-exchange terms
!> \param tddfpt_control TDDFPT control parameters
!> \param matrix_ks Kohn-Sham matrix
!> \param qs_env Quickstep environment
@ -633,7 +649,7 @@ CONTAINS
!> \note Based on the subroutines apply_op() and iterative_solver() originally created by
!> Thomas Chassaing in 2002.
! **************************************************************************************************
FUNCTION tddfpt_davidson_solver(evects, evals, S_evects, gs_mos, do_hfx, tddfpt_control, &
FUNCTION tddfpt_davidson_solver(evects, evals, S_evects, gs_mos, tddfpt_control, &
matrix_ks, qs_env, kernel_env, &
sub_env, logger, iter_unit, energy_unit, &
tddfpt_print_section, work_matrices) RESULT(conv)
@ -642,7 +658,6 @@ CONTAINS
TYPE(cp_fm_p_type), DIMENSION(:, :), INTENT(inout) :: S_evects
TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
INTENT(in) :: gs_mos
LOGICAL, INTENT(in) :: do_hfx
TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks
TYPE(qs_environment_type), POINTER :: qs_env
@ -660,7 +675,7 @@ CONTAINS
max_krylov_vects, nspins, nstates, &
nstates_conv, nvects_exist, nvects_new
INTEGER(kind=int_8) :: nstates_total
LOGICAL :: is_nonortho
LOGICAL :: do_hfx, is_nonortho
REAL(kind=dp) :: t1, t2
REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: evals_last
REAL(kind=dp), DIMENSION(:, :), POINTER :: Atilde
@ -673,6 +688,7 @@ CONTAINS
nspins = SIZE(gs_mos)
nstates = tddfpt_control%nstates
nstates_total = tddfpt_total_number_of_states(gs_mos)
do_hfx = tddfpt_control%do_hfx
IF (debug_this_module) THEN
CPASSERT(SIZE(evects, 1) == nspins)
@ -732,7 +748,7 @@ CONTAINS
evects=krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), &
S_evects=S_krylov(:, nvects_exist + 1:nvects_exist + nvects_new), &
gs_mos=gs_mos, tddfpt_control=tddfpt_control, &
do_hfx=do_hfx, matrix_ks=matrix_ks, &
matrix_ks=matrix_ks, &
qs_env=qs_env, kernel_env=kernel_env, &
sub_env=sub_env, &
work_matrices=work_matrices)

124
src/qs_tddfpt2_fhxc.F
View file

@ -7,18 +7,29 @@
MODULE qs_tddfpt2_fhxc
USE cp_control_types, ONLY: stda_control_type
USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
USE cp_dbcsr_operations, ONLY: copy_fm_to_dbcsr,&
cp_dbcsr_sm_fm_multiply
USE cp_fm_types, ONLY: cp_fm_get_info,&
cp_fm_p_type
USE cp_fm_types, ONLY: cp_fm_create,&
cp_fm_get_info,&
cp_fm_p_type,&
cp_fm_release,&
cp_fm_type
USE cp_gemm_interface, ONLY: cp_gemm
USE dbcsr_api, ONLY: dbcsr_p_type,&
dbcsr_set
USE dbcsr_api, ONLY: &
dbcsr_add, dbcsr_copy, dbcsr_create, dbcsr_deallocate_matrix, dbcsr_get_info, &
dbcsr_p_type, dbcsr_release, dbcsr_set, dbcsr_type, dbcsr_type_symmetric
USE kinds, ONLY: dp
USE pw_env_types, ONLY: pw_env_get
USE pw_methods, ONLY: pw_axpy,&
pw_scale,&
pw_zero
USE pw_types, ONLY: pw_p_type
USE pw_pool_types, ONLY: pw_pool_create_pw,&
pw_pool_give_back_pw,&
pw_pool_type
USE pw_types, ONLY: REALDATA3D,&
REALSPACE,&
pw_p_type
USE qs_environment_types, ONLY: qs_environment_type
USE qs_integrate_potential, ONLY: integrate_v_rspace
USE qs_kernel_types, ONLY: full_kernel_env_type
@ -54,41 +65,52 @@ CONTAINS
!> \param is_rks_triplets indicates that a triplet excited states calculation using
!> spin-unpolarised molecular orbitals has been requested
!> \param do_hfx flag that activates computation of exact-exchange terms
!> \param do_admm ...
!> \param qs_env Quickstep environment
!> \param kernel_env kernel environment
!> \param kernel_env_admm_aux kernel environment for ADMM correction
!> \param sub_env parallel (sub)group environment
!> \param work_matrices collection of work matrices (modified on exit)
!> \param admm_symm use symmetric definition of ADMM kernel correction
!> \par History
!> * 06.2016 created [Sergey Chulkov]
!> * 03.2017 refactored [Sergey Chulkov]
!> * 04.2019 refactored [JHU]
! **************************************************************************************************
SUBROUTINE fhxc_kernel(Aop_evects, evects, is_rks_triplets, &
do_hfx, qs_env, kernel_env, kernel_env_admm_aux, &
sub_env, work_matrices)
do_hfx, do_admm, qs_env, kernel_env, kernel_env_admm_aux, &
sub_env, work_matrices, admm_symm)
TYPE(cp_fm_p_type), DIMENSION(:, :) :: Aop_evects, evects
LOGICAL, INTENT(in) :: is_rks_triplets, do_hfx
LOGICAL, INTENT(in) :: is_rks_triplets, do_hfx, do_admm
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(full_kernel_env_type), POINTER :: kernel_env, kernel_env_admm_aux
TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
TYPE(tddfpt_work_matrices), INTENT(inout) :: work_matrices
LOGICAL, INTENT(in) :: admm_symm
CHARACTER(LEN=*), PARAMETER :: routineN = 'fhxc_kernel'
INTEGER :: handle, ispin, ivect, nao, nspins, nvects
INTEGER :: handle, ispin, ivect, nao, nao_aux, &
nspins, nvects
INTEGER, DIMENSION(:), POINTER :: blk_sizes
INTEGER, DIMENSION(maxspins) :: nactive
LOGICAL :: do_admm
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ia_ao, rho_ia_ao_aux_fit
TYPE(cp_fm_type), POINTER :: work_aux_orb, work_orb_orb
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: A_xc_munu_sub, rho_ia_ao, &
rho_ia_ao_aux_fit
TYPE(dbcsr_type), POINTER :: dbwork
TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_ia_g, rho_ia_g_aux_fit, rho_ia_r, &
rho_ia_r_aux_fit, tau_ia_r, &
tau_ia_r_aux_fit
tau_ia_r_aux_fit, V_rspace_sub
TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
CALL timeset(routineN, handle)
nspins = SIZE(evects, 1)
nvects = SIZE(evects, 2)
do_admm = ASSOCIATED(sub_env%admm_A)
IF (do_admm) THEN
CPASSERT(do_hfx)
CPASSERT(ASSOCIATED(sub_env%admm_A))
END IF
CALL cp_fm_get_info(evects(1, 1)%matrix, nrow_global=nao)
DO ispin = 1, nspins
@ -166,11 +188,77 @@ CONTAINS
wfm_aux_orb=work_matrices%wfm_aux_orb_sub)
! - C_{HF} d^{2}E_{x, ADMM}^{DFT}[\hat{\rho}] / d\hat{\rho}^2
CALL tddfpt_apply_xc(A_ia_rspace=work_matrices%A_ia_rspace_sub, &
kernel_env=kernel_env_admm_aux, &
rho_ia_struct=work_matrices%rho_aux_fit_struct_sub, &
is_rks_triplets=is_rks_triplets, pw_env=sub_env%pw_env, &
work_v_xc=work_matrices%wpw_rspace_sub)
IF (admm_symm) THEN
CALL dbcsr_get_info(rho_ia_ao_aux_fit(1)%matrix, row_blk_size=blk_sizes)
ALLOCATE (A_xc_munu_sub(nspins))
DO ispin = 1, nspins
ALLOCATE (A_xc_munu_sub(ispin)%matrix)
CALL dbcsr_create(matrix=A_xc_munu_sub(ispin)%matrix, name="ADMM_XC", &
dist=sub_env%dbcsr_dist, matrix_type=dbcsr_type_symmetric, &
row_blk_size=blk_sizes, col_blk_size=blk_sizes, nze=0)
CALL cp_dbcsr_alloc_block_from_nbl(A_xc_munu_sub(ispin)%matrix, sub_env%sab_aux_fit)
CALL dbcsr_set(A_xc_munu_sub(ispin)%matrix, 0.0_dp)
END DO
CALL pw_env_get(sub_env%pw_env, auxbas_pw_pool=auxbas_pw_pool)
ALLOCATE (V_rspace_sub(nspins))
DO ispin = 1, nspins
NULLIFY (V_rspace_sub(ispin)%pw)
CALL pw_pool_create_pw(auxbas_pw_pool, V_rspace_sub(ispin)%pw, &
use_data=REALDATA3D, in_space=REALSPACE)
CALL pw_zero(V_rspace_sub(ispin)%pw)
END DO
CALL tddfpt_apply_xc(A_ia_rspace=V_rspace_sub, &
kernel_env=kernel_env_admm_aux, &
rho_ia_struct=work_matrices%rho_aux_fit_struct_sub, &
is_rks_triplets=is_rks_triplets, pw_env=sub_env%pw_env, &
work_v_xc=work_matrices%wpw_rspace_sub)
DO ispin = 1, nspins
CALL pw_scale(V_rspace_sub(ispin)%pw, V_rspace_sub(ispin)%pw%pw_grid%dvol)
CALL integrate_v_rspace(v_rspace=V_rspace_sub(ispin), &
hmat=A_xc_munu_sub(ispin), &
qs_env=qs_env, calculate_forces=.FALSE., &
pw_env_external=sub_env%pw_env, &
basis_type="AUX_FIT", &
task_list_external=sub_env%task_list_aux_fit)
END DO
ALLOCATE (dbwork)
CALL dbcsr_create(dbwork, template=work_matrices%A_ia_munu_sub(1)%matrix)
CALL cp_fm_create(work_aux_orb, &
matrix_struct=work_matrices%wfm_aux_orb_sub%matrix_struct)
CALL cp_fm_create(work_orb_orb, &
matrix_struct=work_matrices%rho_ao_orb_fm_sub%matrix_struct)
CALL cp_fm_get_info(work_aux_orb, nrow_global=nao_aux, ncol_global=nao)
DO ispin = 1, nspins
CALL cp_dbcsr_sm_fm_multiply(A_xc_munu_sub(ispin)%matrix, sub_env%admm_A, &
work_aux_orb, nao)
CALL cp_gemm('T', 'N', nao, nao, nao_aux, 1.0_dp, sub_env%admm_A, &
work_aux_orb, 0.0_dp, work_orb_orb)
CALL dbcsr_copy(dbwork, work_matrices%A_ia_munu_sub(1)%matrix)
CALL dbcsr_set(dbwork, 0.0_dp)
CALL copy_fm_to_dbcsr(work_orb_orb, dbwork, keep_sparsity=.TRUE.)
CALL dbcsr_add(work_matrices%A_ia_munu_sub(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
END DO
CALL dbcsr_release(dbwork)
DEALLOCATE (dbwork)
DO ispin = 1, nspins
CALL pw_pool_give_back_pw(auxbas_pw_pool, V_rspace_sub(ispin)%pw)
END DO
DEALLOCATE (V_rspace_sub)
CALL cp_fm_release(work_aux_orb)
CALL cp_fm_release(work_orb_orb)
DO ispin = 1, nspins
CALL dbcsr_deallocate_matrix(A_xc_munu_sub(ispin)%matrix)
END DO
DEALLOCATE (A_xc_munu_sub)
ELSE
CALL tddfpt_apply_xc(A_ia_rspace=work_matrices%A_ia_rspace_sub, &
kernel_env=kernel_env_admm_aux, &
rho_ia_struct=work_matrices%rho_aux_fit_struct_sub, &
is_rks_triplets=is_rks_triplets, pw_env=sub_env%pw_env, &
work_v_xc=work_matrices%wpw_rspace_sub)
END IF
END IF
! electron-hole Coulomb interaction

1385
src/qs_tddfpt2_fhxc_forces.F Normal file
View file

File diff suppressed because it is too large Load diff

1023
src/qs_tddfpt2_forces.F Normal file
View file

File diff suppressed because it is too large Load diff

214
src/qs_tddfpt2_methods.F
View file

@ -15,11 +15,16 @@ MODULE qs_tddfpt2_methods
USE cp_blacs_env, ONLY: cp_blacs_env_type
USE cp_control_types, ONLY: dft_control_type,&
tddfpt2_control_type
USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set
USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set,&
dbcsr_deallocate_matrix_set
USE cp_fm_pool_types, ONLY: fm_pool_create_fm
USE cp_fm_types, ONLY: cp_fm_get_info,&
USE cp_fm_struct, ONLY: cp_fm_struct_type
USE cp_fm_types, ONLY: cp_fm_create,&
cp_fm_get_info,&
cp_fm_p_type,&
cp_fm_release
cp_fm_release,&
cp_fm_set_all,&
cp_fm_to_fm
USE cp_log_handling, ONLY: cp_get_default_logger,&
cp_logger_get_default_io_unit,&
cp_logger_type
@ -28,10 +33,15 @@ MODULE qs_tddfpt2_methods
cp_print_key_finished_output,&
cp_print_key_unit_nr,&
cp_rm_iter_level
USE dbcsr_api, ONLY: dbcsr_p_type
USE dbcsr_api, ONLY: dbcsr_copy,&
dbcsr_create,&
dbcsr_p_type,&
dbcsr_set
USE exstates_types, ONLY: excited_energy_type
USE header, ONLY: tddfpt_header
USE input_constants, ONLY: tddfpt_dipole_velocity,&
tddfpt_kernel_full,&
tddfpt_kernel_none,&
tddfpt_kernel_stda
USE input_section_types, ONLY: section_vals_get,&
section_vals_get_subs_vals,&
@ -43,6 +53,7 @@ MODULE qs_tddfpt2_methods
qs_environment_type
USE qs_kernel_methods, ONLY: create_kernel_env
USE qs_kernel_types, ONLY: full_kernel_env_type,&
kernel_env_type,&
release_kernel_env
USE qs_mo_types, ONLY: mo_set_p_type
USE qs_scf_methods, ONLY: eigensolver
@ -52,6 +63,12 @@ MODULE qs_tddfpt2_methods
USE qs_tddfpt2_eigensolver, ONLY: tddfpt_davidson_solver,&
tddfpt_orthogonalize_psi1_psi0,&
tddfpt_orthonormalize_psi1_psi1
USE qs_tddfpt2_forces, ONLY: tddfpt_forces,&
tddfpt_resvec1,&
tddfpt_resvec1_admm,&
tddfpt_resvec2,&
tddfpt_resvec2_xtb,&
tddfpt_resvec3
USE qs_tddfpt2_properties, ONLY: tddfpt_dipole_operator,&
tddfpt_print_excitation_analysis,&
tddfpt_print_nto_analysis,&
@ -66,8 +83,7 @@ MODULE qs_tddfpt2_methods
USE qs_tddfpt2_subgroups, ONLY: tddfpt_sub_env_init,&
tddfpt_sub_env_release,&
tddfpt_subgroup_env_type
USE qs_tddfpt2_types, ONLY: kernel_env_type,&
stda_create_work_matrices,&
USE qs_tddfpt2_types, ONLY: stda_create_work_matrices,&
tddfpt_create_work_matrices,&
tddfpt_ground_state_mos,&
tddfpt_release_work_matrices,&
@ -99,14 +115,16 @@ CONTAINS
! **************************************************************************************************
!> \brief Perform TDDFPT calculation.
!> \param qs_env Quickstep environment
!> \param calc_forces ...
!> \par History
!> * 05.2016 created [Sergey Chulkov]
!> * 06.2016 refactored to be used with Davidson eigensolver [Sergey Chulkov]
!> * 03.2017 cleaned and refactored [Sergey Chulkov]
!> \note Based on the subroutines tddfpt_env_init(), and tddfpt_env_deallocate().
! **************************************************************************************************
SUBROUTINE tddfpt(qs_env)
SUBROUTINE tddfpt(qs_env, calc_forces)
TYPE(qs_environment_type), POINTER :: qs_env
LOGICAL, INTENT(IN) :: calc_forces
CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt'
@ -122,9 +140,12 @@ CONTAINS
TYPE(cell_type), POINTER :: cell
TYPE(cp_blacs_env_type), POINTER :: blacs_env
TYPE(cp_fm_p_type), ALLOCATABLE, DIMENSION(:, :) :: dipole_op_mos_occ, evects, S_evects
TYPE(cp_fm_struct_type), POINTER :: matrix_struct
TYPE(cp_logger_type), POINTER :: logger
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_ks_oep, matrix_s
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_ks_oep, matrix_s, &
matrix_s_aux_fit
TYPE(dft_control_type), POINTER :: dft_control
TYPE(excited_energy_type), POINTER :: ex_env
TYPE(full_kernel_env_type), TARGET :: full_kernel_env, kernel_env_admm_aux
TYPE(kernel_env_type) :: kernel_env
TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos
@ -144,11 +165,15 @@ CONTAINS
logger => cp_get_default_logger()
! input section print/xc
NULLIFY (tddfpt_section)
tddfpt_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%TDDFPT")
CALL tddfpt_input(qs_env, do_hfx, do_admm, xc_section, tddfpt_print_section)
CALL get_qs_env(qs_env, blacs_env=blacs_env, cell=cell, dft_control=dft_control, &
matrix_ks=matrix_ks, matrix_s=matrix_s, mos=mos, scf_env=scf_env)
tddfpt_control => dft_control%tddfpt2_control
tddfpt_control%do_hfx = do_hfx
tddfpt_control%do_admm = do_admm
CALL cite_reference(Iannuzzi2005)
IF (tddfpt_control%kernel == tddfpt_kernel_stda) THEN
@ -165,7 +190,7 @@ CONTAINS
CALL tddfpt_init_mos(qs_env, gs_mos)
! obtain corrected KS-matrix
CALL tddfpt_oecorr(qs_env, gs_mos, matrix_ks_oep, do_hfx)
CALL tddfpt_oecorr(qs_env, gs_mos, matrix_ks_oep)
NULLIFY (admm_env)
IF (do_admm) CALL get_qs_env(qs_env, admm_env=admm_env)
@ -205,7 +230,7 @@ CONTAINS
! allocate pools and work matrices
nstates = tddfpt_control%nstates
CALL tddfpt_create_work_matrices(work_matrices, gs_mos, nstates, do_hfx, qs_env, sub_env)
CALL tddfpt_create_work_matrices(work_matrices, gs_mos, nstates, do_hfx, do_admm, qs_env, sub_env)
CALL tddfpt_construct_ground_state_orb_density(rho_orb_struct=work_matrices%rho_orb_struct_sub, &
is_rks_triplets=tddfpt_control%rks_triplets, &
@ -260,6 +285,13 @@ CONTAINS
kernel_env%stda_kernel => stda_kernel
NULLIFY (kernel_env%full_kernel)
NULLIFY (kernel_env%admm_kernel)
ELSE IF (tddfpt_control%kernel == tddfpt_kernel_none) THEN
! allocate pools and work matrices
nstates = tddfpt_control%nstates
CALL stda_create_work_matrices(work_matrices, gs_mos, nstates, qs_env, sub_env)
NULLIFY (kernel_env%full_kernel)
NULLIFY (kernel_env%admm_kernel)
NULLIFY (kernel_env%stda_kernel)
ELSE
CPABORT('Unknown kernel type')
END IF
@ -315,7 +347,7 @@ CONTAINS
DO
! *** perform Davidson iterations ***
conv = tddfpt_davidson_solver(evects=evects, evals=evals, S_evects=S_evects, gs_mos=gs_mos, &
do_hfx=do_hfx, tddfpt_control=tddfpt_control, &
tddfpt_control=tddfpt_control, &
matrix_ks=matrix_ks, qs_env=qs_env, &
kernel_env=kernel_env, &
sub_env=sub_env, logger=logger, &
@ -385,9 +417,112 @@ CONTAINS
CALL tddfpt_print_nto_analysis(qs_env, evects, evals, gs_mos, matrix_s(1)%matrix, &
tddfpt_print_section)
! -- clean up all useless stuff
DO istate = SIZE(evects, 2), 1, -1
DO ispin = nspins, 1, -1
! excited state potential energy surface
IF (qs_env%excited_state) THEN
CALL get_qs_env(qs_env, exstate_env=ex_env)
IF (ex_env%state > nstates) THEN
CALL cp_warn(__LOCATION__, "There were not enough excited states calculated.")
CPABORT("excited state potential energy surface")
END IF
!
! energy
ex_env%evalue = evals(ex_env%state)
! excitation vector
IF (ASSOCIATED(ex_env%evect)) THEN
DO ispin = 1, SIZE(ex_env%evect)
CALL cp_fm_release(ex_env%evect(ispin)%matrix)
END DO
DEALLOCATE (ex_env%evect)
END IF
ALLOCATE (ex_env%evect(nspins))
DO ispin = 1, nspins
CALL cp_fm_get_info(matrix=evects(ispin, 1)%matrix, matrix_struct=matrix_struct)
NULLIFY (ex_env%evect(ispin)%matrix)
CALL cp_fm_create(ex_env%evect(ispin)%matrix, matrix_struct)
CALL cp_fm_to_fm(evects(ispin, ex_env%state)%matrix, ex_env%evect(ispin)%matrix)
END DO
IF (calc_forces) THEN
! rhs of linres equation
IF (ASSOCIATED(ex_env%cpmos)) THEN
DO ispin = 1, SIZE(ex_env%cpmos)
CALL cp_fm_release(ex_env%cpmos(ispin)%matrix)
END DO
DEALLOCATE (ex_env%cpmos)
END IF
ALLOCATE (ex_env%cpmos(nspins))
DO ispin = 1, nspins
CALL cp_fm_get_info(matrix=evects(ispin, 1)%matrix, matrix_struct=matrix_struct)
NULLIFY (ex_env%cpmos(ispin)%matrix)
CALL cp_fm_create(ex_env%cpmos(ispin)%matrix, matrix_struct)
CALL cp_fm_set_all(ex_env%cpmos(ispin)%matrix, 0.0_dp)
END DO
CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s)
CALL dbcsr_allocate_matrix_set(ex_env%matrix_pe, nspins)
DO ispin = 1, nspins
ALLOCATE (ex_env%matrix_pe(ispin)%matrix)
CALL dbcsr_create(ex_env%matrix_pe(ispin)%matrix, template=matrix_s(1)%matrix)
CALL dbcsr_copy(ex_env%matrix_pe(ispin)%matrix, matrix_s(1)%matrix)
CALL dbcsr_set(ex_env%matrix_pe(ispin)%matrix, 0.0_dp)
CALL tddfpt_resvec1(ex_env%evect(ispin)%matrix, gs_mos(ispin)%mos_occ, &
matrix_s(1)%matrix, ex_env%matrix_pe(ispin)%matrix)
END DO
!
! ground state ADMM!
IF (dft_control%do_admm) THEN
CALL get_qs_env(qs_env, admm_env=admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
CALL dbcsr_allocate_matrix_set(ex_env%matrix_pe_admm, nspins)
DO ispin = 1, nspins
ALLOCATE (ex_env%matrix_pe_admm(ispin)%matrix)
CALL dbcsr_create(ex_env%matrix_pe_admm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
CALL dbcsr_copy(ex_env%matrix_pe_admm(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
CALL dbcsr_set(ex_env%matrix_pe_admm(ispin)%matrix, 0.0_dp)
CALL tddfpt_resvec1_admm(ex_env%matrix_pe(ispin)%matrix, &
admm_env, ex_env%matrix_pe_admm(ispin)%matrix)
END DO
END IF
!
CALL dbcsr_allocate_matrix_set(ex_env%matrix_hz, nspins)
DO ispin = 1, nspins
ALLOCATE (ex_env%matrix_hz(ispin)%matrix)
CALL dbcsr_create(ex_env%matrix_hz(ispin)%matrix, template=matrix_s(1)%matrix)
CALL dbcsr_copy(ex_env%matrix_hz(ispin)%matrix, matrix_s(1)%matrix)
CALL dbcsr_set(ex_env%matrix_hz(ispin)%matrix, 0.0_dp)
END DO
IF (dft_control%qs_control%xtb) THEN
CALL tddfpt_resvec2_xtb(qs_env, ex_env%matrix_pe, gs_mos, ex_env%matrix_hz, ex_env%cpmos)
ELSE
CALL tddfpt_resvec2(qs_env, ex_env%matrix_pe, ex_env%matrix_pe_admm, &
gs_mos, ex_env%matrix_hz, ex_env%cpmos)
END IF
!
CALL dbcsr_allocate_matrix_set(ex_env%matrix_px1, nspins)
DO ispin = 1, nspins
ALLOCATE (ex_env%matrix_px1(ispin)%matrix)
CALL dbcsr_create(ex_env%matrix_px1(ispin)%matrix, template=matrix_s(1)%matrix)
CALL dbcsr_copy(ex_env%matrix_px1(ispin)%matrix, matrix_s(1)%matrix)
CALL dbcsr_set(ex_env%matrix_px1(ispin)%matrix, 0.0_dp)
END DO
! Kernel ADMM
IF (tddfpt_control%do_admm) THEN
CALL get_qs_env(qs_env, admm_env=admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
CALL dbcsr_allocate_matrix_set(ex_env%matrix_px1_admm, nspins)
DO ispin = 1, nspins
ALLOCATE (ex_env%matrix_px1_admm(ispin)%matrix)
CALL dbcsr_create(ex_env%matrix_px1_admm(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix)
CALL dbcsr_copy(ex_env%matrix_px1_admm(ispin)%matrix, matrix_s_aux_fit(1)%matrix)
CALL dbcsr_set(ex_env%matrix_px1_admm(ispin)%matrix, 0.0_dp)
END DO
END IF
! TDA forces
CALL tddfpt_forces(qs_env, ex_env, gs_mos, kernel_env, sub_env, work_matrices)
! Rotate res vector cpmos into original frame of occupied orbitals
CALL tddfpt_resvec3(qs_env, ex_env%cpmos, work_matrices)
END IF
END IF
! clean up
DO istate = 1, SIZE(evects, 2)
DO ispin = 1, nspins
CALL cp_fm_release(evects(ispin, istate)%matrix)
CALL cp_fm_release(S_evects(ispin, istate)%matrix)
END DO
@ -399,6 +534,8 @@ CONTAINS
CALL release_kernel_env(kernel_env%full_kernel)
ELSE IF (tddfpt_control%kernel == tddfpt_kernel_stda) THEN
CALL deallocate_stda_env(stda_kernel)
ELSE IF (tddfpt_control%kernel == tddfpt_kernel_none) THEN
!
ELSE
CPABORT('Unknown kernel type')
END IF
@ -464,30 +601,35 @@ CONTAINS
tddfpt_section => section_vals_get_subs_vals(input, "PROPERTIES%TDDFPT")
tddfpt_print_section => section_vals_get_subs_vals(tddfpt_section, "PRINT")
NULLIFY (xc_section)
xc_section => section_vals_get_subs_vals(tddfpt_section, "XC%XC_FUNCTIONAL")
CALL section_vals_get(xc_section, explicit=explicit_xc)
IF (explicit_xc) THEN
xc_section => section_vals_get_subs_vals(tddfpt_section, "XC")
ELSE
xc_section => section_vals_get_subs_vals(input, "DFT%XC")
END IF
hfx_section => section_vals_get_subs_vals(xc_section, "HF")
CALL section_vals_get(hfx_section, explicit=do_hfx)
IF (do_hfx) THEN
CALL section_vals_val_get(hfx_section, "FRACTION", r_val=C_hf)
do_hfx = (C_hf /= 0.0_dp)
END IF
do_admm = do_hfx .AND. dft_control%do_admm
IF (do_admm) THEN
IF (tddfpt_control%kernel == tddfpt_kernel_full) THEN
NULLIFY (xc_section)
xc_section => section_vals_get_subs_vals(tddfpt_section, "XC%XC_FUNCTIONAL")
CALL section_vals_get(xc_section, explicit=explicit_xc)
IF (explicit_xc) THEN
! 'admm_env%xc_section_primary' and 'admm_env%xc_section_aux' need to be redefined
CALL cp_abort(__LOCATION__, &
"ADMM is not implemented for a TDDFT kernel XC-functional which is different from "// &
"the one used for the ground-state calculation. A ground-state 'admm_env' cannot be reused.")
xc_section => section_vals_get_subs_vals(tddfpt_section, "XC")
ELSE
xc_section => section_vals_get_subs_vals(input, "DFT%XC")
END IF
hfx_section => section_vals_get_subs_vals(xc_section, "HF")
CALL section_vals_get(hfx_section, explicit=do_hfx)
IF (do_hfx) THEN
CALL section_vals_val_get(hfx_section, "FRACTION", r_val=C_hf)
do_hfx = (C_hf /= 0.0_dp)
END IF
do_admm = do_hfx .AND. dft_control%do_admm
IF (do_admm) THEN
IF (explicit_xc) THEN
! 'admm_env%xc_section_primary' and 'admm_env%xc_section_aux' need to be redefined
CALL cp_abort(__LOCATION__, &
"ADMM is not implemented for a TDDFT kernel XC-functional which is different from "// &
"the one used for the ground-state calculation. A ground-state 'admm_env' cannot be reused.")
END IF
END IF
ELSE
do_hfx = .FALSE.
do_admm = .FALSE.
END IF
! reset rks_triplets if UKS is in use

2
src/qs_tddfpt2_restart.F
View file

@ -173,6 +173,8 @@ CONTAINS
CALL timeset(routineN, handle)
CPASSERT(ASSOCIATED(tddfpt_section))
! generate restart file name
CALL section_vals_val_get(tddfpt_section, "WFN_RESTART_FILE_NAME", n_rep_val=n_rep_val)
IF (n_rep_val > 0) THEN

154
src/qs_tddfpt2_stda_utils.F
View file

@ -24,18 +24,14 @@ MODULE qs_tddfpt2_stda_utils
dbcsr_allocate_matrix_set
USE cp_fm_basic_linalg, ONLY: cp_fm_row_scale,&
cp_fm_schur_product
USE cp_fm_diag, ONLY: cp_fm_power
USE cp_fm_diag, ONLY: choose_eigv_solver,&
cp_fm_power
USE cp_fm_struct, ONLY: cp_fm_struct_create,&
cp_fm_struct_release,&
cp_fm_struct_type
USE cp_fm_types, ONLY: cp_fm_create,&
cp_fm_get_info,&
cp_fm_p_type,&
cp_fm_release,&
cp_fm_set_all,&
cp_fm_to_fm,&
cp_fm_type,&
cp_fm_vectorssum
USE cp_fm_types, ONLY: &
cp_fm_create, cp_fm_get_info, cp_fm_p_type, cp_fm_release, cp_fm_set_all, &
cp_fm_set_submatrix, cp_fm_to_fm, cp_fm_type, cp_fm_vectorssum
USE cp_log_handling, ONLY: cp_get_default_logger,&
cp_logger_get_default_io_unit,&
cp_logger_type
@ -44,7 +40,8 @@ MODULE qs_tddfpt2_stda_utils
dbcsr_add_on_diag, dbcsr_create, dbcsr_distribution_type, dbcsr_filter, dbcsr_finalize, &
dbcsr_get_block_p, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, &
dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_p_type, &
dbcsr_release, dbcsr_set, dbcsr_type, dbcsr_type_no_symmetry, dbcsr_type_symmetric
dbcsr_release, dbcsr_set, dbcsr_type, dbcsr_type_antisymmetric, dbcsr_type_no_symmetry, &
dbcsr_type_symmetric
USE ewald_environment_types, ONLY: ewald_env_create,&
ewald_env_get,&
ewald_env_set,&
@ -86,7 +83,7 @@ MODULE qs_tddfpt2_stda_utils
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_stda_utils'
PUBLIC:: stda_init_matrices, stda_calculate_kernel
PUBLIC:: stda_init_matrices, stda_calculate_kernel, get_lowdin_x, setup_gamma
CONTAINS
@ -151,27 +148,28 @@ CONTAINS
!> \param stda_env ...
!> \param sub_env ...
!> \param gamma_matrix sTDA exchange-type contributions
!> \param ndim ...
!> \note Note the specific sTDA notation exchange-type integrals (ia|jb) refer to Coulomb interaction
! **************************************************************************************************
SUBROUTINE setup_gamma(qs_env, stda_env, sub_env, gamma_matrix)
SUBROUTINE setup_gamma(qs_env, stda_env, sub_env, gamma_matrix, ndim)
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(stda_env_type) :: stda_env
TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: gamma_matrix
INTEGER, INTENT(IN), OPTIONAL :: ndim
CHARACTER(len=*), PARAMETER :: routineN = 'setup_gamma'
REAL(KIND=dp), PARAMETER :: rsmooth = 1.0_dp
CHARACTER(len=20) :: cstring
INTEGER :: handle, iatom, icol, ikind, irow, jatom, &
jkind, natom, nmat
INTEGER :: handle, i, iatom, icol, ikind, imat, &
irow, jatom, jkind, natom, nmat
INTEGER, DIMENSION(:), POINTER :: row_blk_sizes
LOGICAL :: found
REAL(KIND=dp) :: dr, eta, fcut, r, ralpha, rcut, rcuta, &
rcutb, x
REAL(KIND=dp) :: dfcut, dgb, dr, eta, fcut, r, rcut, &
rcuta, rcutb, x
REAL(KIND=dp), DIMENSION(3) :: rij
REAL(KIND=dp), DIMENSION(:, :), POINTER :: gblock
REAL(KIND=dp), DIMENSION(:, :), POINTER :: dgblock, gblock
TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
TYPE(neighbor_list_iterator_p_type), &
DIMENSION(:), POINTER :: nl_iterator
@ -180,28 +178,42 @@ CONTAINS
CALL timeset(routineN, handle)
cstring = "GAMMA EXCHANGE MATRIX"
CALL get_qs_env(qs_env=qs_env, natom=natom)
dbcsr_dist => sub_env%dbcsr_dist
n_list => sub_env%sab_orb
CALL get_qs_env(qs_env=qs_env, natom=natom)
CALL get_qs_env(qs_env=qs_env, dbcsr_dist=dbcsr_dist, sab_orb=n_list)
nmat = 1
NULLIFY (gamma_matrix)
IF (PRESENT(ndim)) THEN
nmat = ndim
ELSE
nmat = 1
END IF
CPASSERT(nmat == 1 .OR. nmat == 4)
CPASSERT(.NOT. ASSOCIATED(gamma_matrix))
CALL dbcsr_allocate_matrix_set(gamma_matrix, nmat)
ALLOCATE (row_blk_sizes(natom))
row_blk_sizes(1:natom) = 1
ALLOCATE (gamma_matrix(1)%matrix)
DO imat = 1, nmat
ALLOCATE (gamma_matrix(imat)%matrix)
END DO
CALL dbcsr_create(gamma_matrix(1)%matrix, name=TRIM(ADJUSTL(cstring)), dist=dbcsr_dist, &
CALL dbcsr_create(gamma_matrix(1)%matrix, name="gamma", dist=dbcsr_dist, &
matrix_type=dbcsr_type_symmetric, row_blk_size=row_blk_sizes, &
col_blk_size=row_blk_sizes, nze=0, mutable_work=.TRUE.)
col_blk_size=row_blk_sizes, nze=0)
DO imat = 2, nmat
CALL dbcsr_create(gamma_matrix(imat)%matrix, name="dgamma", dist=dbcsr_dist, &
matrix_type=dbcsr_type_antisymmetric, row_blk_size=row_blk_sizes, &
col_blk_size=row_blk_sizes, nze=0)
END DO
DEALLOCATE (row_blk_sizes)
! setup the matrices using the neighbor list
CALL cp_dbcsr_alloc_block_from_nbl(gamma_matrix(1)%matrix, n_list)
CALL dbcsr_set(gamma_matrix(1)%matrix, 0.0_dp)
DO imat = 1, nmat
CALL cp_dbcsr_alloc_block_from_nbl(gamma_matrix(imat)%matrix, n_list)
CALL dbcsr_set(gamma_matrix(imat)%matrix, 0.0_dp)
END DO
NULLIFY (nl_iterator)
CALL neighbor_list_iterator_create(nl_iterator, n_list)
@ -242,16 +254,59 @@ CONTAINS
x = r/rsmooth
fcut = -6._dp*x**5 + 15._dp*x**4 - 10._dp*x**3 + 1._dp
END IF
ralpha = dr**stda_env%alpha_param
gblock(:, :) = gblock(:, :) + &
fcut*(1._dp/(dr**(stda_env%alpha_param) + eta**(-stda_env%alpha_param))) &
**(1._dp/stda_env%alpha_param) - fcut/dr
END IF
IF (nmat > 1) THEN
!> Computes the short-range gamma parameter from
!> Nataga-Mishimoto-Ohno-Klopman formula equivalently as it is done for xTB
!> Derivatives
IF (dr < 1.e-6 .OR. dr > rcut) THEN
! on site terms or beyond cutoff
dgb = 0.0_dp
ELSE
IF (dr < rcut - rsmooth) THEN
fcut = 1.0_dp
dfcut = 0.0_dp
ELSE
r = dr - (rcut - rsmooth)
x = r/rsmooth
fcut = -6._dp*x**5 + 15._dp*x**4 - 10._dp*x**3 + 1._dp
dfcut = -30._dp*x**4 + 60._dp*x**3 - 30._dp*x**2
dfcut = dfcut/rsmooth
END IF
dgb = dfcut*(1._dp/(dr**(stda_env%alpha_param) + eta**(-stda_env%alpha_param))) &
**(1._dp/stda_env%alpha_param)
dgb = dgb - dfcut/dr + fcut/dr**2
dgb = dgb - fcut*(1._dp/(dr**(stda_env%alpha_param) + eta**(-stda_env%alpha_param))) &
**(1._dp/stda_env%alpha_param + 1._dp)*dr**(stda_env%alpha_param - 1._dp)
END IF
DO imat = 2, nmat
NULLIFY (dgblock)
CALL dbcsr_get_block_p(matrix=gamma_matrix(imat)%matrix, &
row=irow, col=icol, BLOCK=dgblock, found=found)
IF (found) THEN
IF (dr > 1.e-6) THEN
i = imat - 1
IF (irow == iatom) THEN
dgblock(:, :) = dgblock(:, :) + dgb*rij(i)/dr
ELSE
dgblock(:, :) = dgblock(:, :) - dgb*rij(i)/dr
END IF
END IF
END IF
END DO
END IF
END DO
CALL neighbor_list_iterator_release(nl_iterator)
CALL dbcsr_finalize(gamma_matrix(1)%matrix)
DO imat = 1, nmat
CALL dbcsr_finalize(gamma_matrix(imat)%matrix)
END DO
CALL timestop(handle)
@ -271,11 +326,13 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'get_lowdin_mo_coefficients'
INTEGER :: handle, iounit, ispin, max_iter_lanczos, &
nactive, ndep, nsgf, nspins, &
order_lanczos
INTEGER :: handle, i, iounit, ispin, j, &
max_iter_lanczos, nactive, ndep, nsgf, &
nspins, order_lanczos
LOGICAL :: converged
REAL(KIND=dp) :: eps_lanczos, threshold
REAL(KIND=dp) :: eps_lanczos, sij, threshold
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: slam
REAL(KIND=dp), DIMENSION(:, :), POINTER :: local_data
TYPE(cp_fm_struct_type), POINTER :: fmstruct
TYPE(cp_fm_type), POINTER :: fm_s_half, fm_work1
TYPE(cp_logger_type), POINTER :: logger
@ -360,6 +417,36 @@ CONTAINS
work%ctransformed(ispin)%matrix, nactive, alpha=1.0_dp, beta=0.0_dp)
ENDDO
! for Lowdin forces
CALL cp_fm_create(matrix=fm_work1, matrix_struct=work%S_eigenvectors%matrix_struct, name="TMP MATRIX")
CALL copy_dbcsr_to_fm(sm_s, fm_work1)
CALL choose_eigv_solver(fm_work1, work%S_eigenvectors, work%S_eigenvalues)
CALL cp_fm_release(matrix=fm_work1)
!
ALLOCATE (slam(nsgf, 1))
DO i = 1, nsgf
IF (work%S_eigenvalues(i) > 0._dp) THEN
slam(i, 1) = SQRT(work%S_eigenvalues(i))
ELSE
CPABORT("S matrix not positive definit")
END IF
END DO
DO i = 1, nsgf
CALL cp_fm_set_submatrix(work%slambda, slam, 1, i, nsgf, 1, 1.0_dp, 0.0_dp)
END DO
DO i = 1, nsgf
CALL cp_fm_set_submatrix(work%slambda, slam, i, 1, 1, nsgf, 1.0_dp, 1.0_dp, .TRUE.)
END DO
CALL cp_fm_get_info(work%slambda, local_data=local_data)
DO i = 1, SIZE(local_data, 2)
DO j = 1, SIZE(local_data, 1)
sij = local_data(j, i)
IF (sij > 0.0_dp) sij = 1.0_dp/sij
local_data(j, i) = sij
END DO
END DO
DEALLOCATE (slam)
CALL timestop(handle)
END SUBROUTINE get_lowdin_mo_coefficients
@ -596,6 +683,7 @@ CONTAINS
! P(nu,mu) = SUM_j XT(nu,j)*CT(mu,j)
ct => work%ctransformed(ispin)%matrix
xt => xtransformed(ispin)%matrix
CALL dbcsr_set(pdens, 0.0_dp)
CALL cp_dbcsr_plus_fm_fm_t(pdens, xt, ct, nactive(ispin), &
1.0_dp, keep_sparsity=.FALSE.)
CALL dbcsr_filter(pdens, stda_env%eps_td_filter)

19
src/qs_tddfpt2_subgroups.F
View file

@ -45,6 +45,7 @@ MODULE qs_tddfpt2_subgroups
distribution_2d_type
USE distribution_methods, ONLY: distribute_molecules_2d
USE input_constants, ONLY: tddfpt_kernel_full,&
tddfpt_kernel_none,&
tddfpt_kernel_stda
USE input_section_types, ONLY: section_vals_type,&
section_vals_val_get
@ -323,6 +324,24 @@ CONTAINS
ELSE
CALL get_qs_env(qs_env, dbcsr_dist=sub_env%dbcsr_dist, sab_orb=sub_env%sab_orb)
END IF
ELSE IF (kernel == tddfpt_kernel_none) THEN
sub_env%is_mgrid = .FALSE.
NULLIFY (sub_env%dbcsr_dist, sub_env%dist_2d)
NULLIFY (sub_env%sab_orb, sub_env%sab_aux_fit)
NULLIFY (sub_env%task_list_orb, sub_env%task_list_aux_fit)
NULLIFY (sub_env%pw_env)
IF (sub_env%is_split) THEN
CALL tddfpt_build_distribution_2d(distribution_2d=sub_env%dist_2d, dbcsr_dist=sub_env%dbcsr_dist, &
blacs_env=sub_env%blacs_env, qs_env=qs_env)
! maybe we don't need task_list, just sab_orb
CALL tddfpt_build_tasklist(task_list=sub_env%task_list_orb, sab=sub_env%sab_orb, basis_type="ORB", &
distribution_2d=sub_env%dist_2d, pw_env=sub_env%pw_env, qs_env=qs_env, &
skip_load_balance=qs_control%skip_load_balance_distributed, &
reorder_grid_ranks=.TRUE.)
CPABORT('subsys missing')
ELSE
CALL get_qs_env(qs_env, dbcsr_dist=sub_env%dbcsr_dist, sab_orb=sub_env%sab_orb)
END IF
ELSE
CPABORT("Unknown kernel type")
END IF

178
src/qs_tddfpt2_types.F
View file

@ -21,6 +21,7 @@ MODULE qs_tddfpt2_types
cp_fm_struct_release,&
cp_fm_struct_type
USE cp_fm_types, ONLY: cp_fm_create,&
cp_fm_get_info,&
cp_fm_p_type,&
cp_fm_release,&
cp_fm_type
@ -39,6 +40,11 @@ MODULE qs_tddfpt2_types
ewald_environment_type
USE ewald_pw_types, ONLY: ewald_pw_release,&
ewald_pw_type
USE input_section_types, ONLY: section_get_ival,&
section_get_lval,&
section_get_rval,&
section_vals_get_subs_vals,&
section_vals_type
USE kinds, ONLY: dp
USE pw_env_types, ONLY: pw_env_get
USE pw_pool_types, ONLY: pw_pool_create_pw,&
@ -55,12 +61,17 @@ MODULE qs_tddfpt2_types
USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
USE qs_rho_methods, ONLY: qs_rho_rebuild
USE qs_rho_types, ONLY: qs_rho_create,&
qs_rho_get,&
qs_rho_release,&
qs_rho_set,&
qs_rho_type
USE qs_tddfpt2_stda_types, ONLY: stda_env_type
USE qs_tddfpt2_subgroups, ONLY: tddfpt_dbcsr_create_by_dist,&
tddfpt_subgroup_env_type
USE xc, ONLY: xc_prep_2nd_deriv
USE xc_derivative_set_types, ONLY: xc_dset_release
USE xc_derivatives, ONLY: xc_functionals_get_needs
USE xc_rho_set_types, ONLY: xc_rho_set_create,&
xc_rho_set_release
#include "./base/base_uses.f90"
IMPLICIT NONE
@ -74,7 +85,7 @@ MODULE qs_tddfpt2_types
INTEGER, PARAMETER, PRIVATE :: nderivs = 3
INTEGER, PARAMETER, PRIVATE :: maxspins = 2
PUBLIC :: tddfpt_ground_state_mos, tddfpt_work_matrices, kernel_env_type
PUBLIC :: tddfpt_ground_state_mos, tddfpt_work_matrices
PUBLIC :: tddfpt_create_work_matrices, stda_create_work_matrices, tddfpt_release_work_matrices
! **************************************************************************************************
@ -175,22 +186,15 @@ MODULE qs_tddfpt2_types
TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: ctransformed
!S^1/2
TYPE(dbcsr_type), POINTER :: shalf
!Eigenvalues/eigenvectors of the overlap matrix, used in sTDA forces (Lowdin derivatives)
REAL(KIND=dp), DIMENSION(:), POINTER :: S_eigenvalues
TYPE(cp_fm_type), POINTER :: S_eigenvectors
TYPE(cp_fm_type), POINTER :: slambda
!Ewald environments
TYPE(ewald_environment_type), POINTER :: ewald_env
TYPE(ewald_pw_type), POINTER :: ewald_pw
END TYPE tddfpt_work_matrices
! **************************************************************************************************
!> \brief Type to hold environments for the different kernels
!> \par History
!> * 04.2019 created [JHU]
! **************************************************************************************************
TYPE kernel_env_type
TYPE(full_kernel_env_type), POINTER :: full_kernel => Null()
TYPE(full_kernel_env_type), POINTER :: admm_kernel => Null()
TYPE(stda_env_type), POINTER :: stda_kernel => Null()
END TYPE kernel_env_type
CONTAINS
! **************************************************************************************************
@ -200,17 +204,19 @@ CONTAINS
!> \param nstates number of excited states to converge
!> \param do_hfx flag that requested to allocate work matrices required for computation
!> of exact-exchange terms
!> \param do_admm ...
!> \param qs_env Quickstep environment
!> \param sub_env parallel group environment
!> \par History
!> * 02.2017 created [Sergey Chulkov]
! **************************************************************************************************
SUBROUTINE tddfpt_create_work_matrices(work_matrices, gs_mos, nstates, do_hfx, qs_env, sub_env)
SUBROUTINE tddfpt_create_work_matrices(work_matrices, gs_mos, nstates, do_hfx, do_admm, &
qs_env, sub_env)
TYPE(tddfpt_work_matrices), INTENT(out) :: work_matrices
TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
INTENT(in) :: gs_mos
INTEGER, INTENT(in) :: nstates
LOGICAL, INTENT(in) :: do_hfx
LOGICAL, INTENT(in) :: do_hfx, do_admm
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
@ -219,7 +225,6 @@ CONTAINS
INTEGER :: handle, igroup, ispin, istate, nao, &
nao_aux, ngroups, nspins
INTEGER, DIMENSION(maxspins) :: nmo_occ, nmo_virt
LOGICAL :: do_admm
TYPE(cp_blacs_env_type), POINTER :: blacs_env
TYPE(cp_fm_struct_p_type), DIMENSION(maxspins) :: fm_struct_evects
TYPE(cp_fm_struct_type), POINTER :: fm_struct
@ -239,6 +244,9 @@ CONTAINS
NULLIFY (work_matrices%ewald_pw)
NULLIFY (work_matrices%gamma_exchange)
NULLIFY (work_matrices%ctransformed)
NULLIFY (work_matrices%S_eigenvalues)
NULLIFY (work_matrices%S_eigenvectors)
NULLIFY (work_matrices%slambda)
nspins = SIZE(gs_mos)
CALL get_qs_env(qs_env, blacs_env=blacs_env, matrix_s=matrix_s)
@ -249,8 +257,9 @@ CONTAINS
nmo_virt(ispin) = SIZE(gs_mos(ispin)%evals_virt)
END DO
do_admm = do_hfx .AND. ASSOCIATED(sub_env%admm_A)
IF (do_admm) THEN
CPASSERT(do_hfx)
CPASSERT(ASSOCIATED(sub_env%admm_A))
CALL get_qs_env(qs_env, matrix_s_aux_fit=matrix_s_aux_fit)
CALL dbcsr_get_info(matrix_s_aux_fit(1)%matrix, nfullrows_total=nao_aux)
END IF
@ -526,6 +535,13 @@ CONTAINS
NULLIFY (work_matrices%shalf)
CALL dbcsr_init_p(work_matrices%shalf)
CALL dbcsr_create(work_matrices%shalf, template=matrix_s(1)%matrix)
! forces
ALLOCATE (work_matrices%S_eigenvalues(nao))
NULLIFY (fm_struct)
CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
CALL cp_fm_create(work_matrices%S_eigenvectors, fm_struct)
CALL cp_fm_create(work_matrices%slambda, fm_struct)
CALL cp_fm_struct_release(fm_struct)
DO ispin = nspins, 1, -1
CALL cp_fm_struct_release(fm_struct_evects(ispin)%struct)
@ -642,6 +658,13 @@ CONTAINS
NULLIFY (work_matrices%ctransformed)
ENDIF
CALL dbcsr_release_p(work_matrices%shalf)
!
IF (ASSOCIATED(work_matrices%S_eigenvectors)) &
CALL cp_fm_release(work_matrices%S_eigenvectors)
IF (ASSOCIATED(work_matrices%slambda)) &
CALL cp_fm_release(work_matrices%slambda)
IF (ASSOCIATED(work_matrices%S_eigenvalues)) &
DEALLOCATE (work_matrices%S_eigenvalues)
! Ewald
CALL ewald_env_release(work_matrices%ewald_env)
CALL ewald_pw_release(work_matrices%ewald_pw)
@ -650,4 +673,125 @@ CONTAINS
END SUBROUTINE tddfpt_release_work_matrices
! **************************************************************************************************
!> \brief Create kernel environment.
!> \param kernel_env kernel environment (allocated and initialised on exit)
!> \param rho_struct_sub ground state charge density
!> \param xc_section input section which defines an exchange-correlation functional
!> \param is_rks_triplets indicates that the triplet excited states calculation using
!> spin-unpolarised molecular orbitals has been requested
!> \param sub_env parallel group environment
!> \par History
!> * 02.2017 created [Sergey Chulkov]
!> * 06.2018 the charge density needs to be provided via a dummy argument [Sergey Chulkov]
! **************************************************************************************************
SUBROUTINE tddfpt_create_kernel_env(kernel_env, rho_struct_sub, xc_section, is_rks_triplets, sub_env)
TYPE(full_kernel_env_type), INTENT(out) :: kernel_env
TYPE(qs_rho_type), POINTER :: rho_struct_sub
TYPE(section_vals_type), POINTER :: xc_section
LOGICAL, INTENT(in) :: is_rks_triplets
TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_create_kernel_env'
INTEGER :: handle, ispin, nao, nspins
INTEGER, DIMENSION(maxspins) :: nmo_occ
LOGICAL :: lsd
TYPE(pw_p_type), DIMENSION(:), POINTER :: rho_ij_r, rho_ij_r2, tau_ij_r, tau_ij_r2
TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
TYPE(section_vals_type), POINTER :: xc_fun_section
CALL timeset(routineN, handle)
nspins = SIZE(sub_env%mos_occ)
lsd = (nspins > 1) .OR. is_rks_triplets
DO ispin = 1, nspins
CALL cp_fm_get_info(sub_env%mos_occ(ispin)%matrix, nrow_global=nao, ncol_global=nmo_occ(ispin))
END DO
CALL pw_env_get(sub_env%pw_env, auxbas_pw_pool=auxbas_pw_pool)
CALL qs_rho_get(rho_struct_sub, rho_r=rho_ij_r, tau_r=tau_ij_r)
NULLIFY (kernel_env%xc_rho_set, kernel_env%xc_rho1_set, kernel_env%xc_deriv_set)
IF (is_rks_triplets) THEN
! we are about to compute triplet states using spin-restricted reference MOs;
! we still need the beta-spin density component in order to compute the TDDFT kernel
ALLOCATE (rho_ij_r2(2))
rho_ij_r2(1)%pw => rho_ij_r(1)%pw
rho_ij_r2(2)%pw => rho_ij_r(1)%pw
IF (ASSOCIATED(tau_ij_r)) THEN
ALLOCATE (tau_ij_r2(2))
tau_ij_r2(1)%pw => tau_ij_r(1)%pw
tau_ij_r2(2)%pw => tau_ij_r(1)%pw
END IF
CALL xc_prep_2nd_deriv(kernel_env%xc_deriv_set, kernel_env%xc_rho_set, rho_ij_r2, &
auxbas_pw_pool, xc_section=xc_section, tau_r=tau_ij_r2)
IF (ASSOCIATED(tau_ij_r)) DEALLOCATE (tau_ij_r2)
DEALLOCATE (rho_ij_r2)
ELSE
CALL xc_prep_2nd_deriv(kernel_env%xc_deriv_set, kernel_env%xc_rho_set, rho_ij_r, &
auxbas_pw_pool, xc_section=xc_section, tau_r=tau_ij_r)
END IF
! ++ allocate structure for response density
kernel_env%xc_section => xc_section
kernel_env%deriv_method_id = section_get_ival(xc_section, "XC_GRID%XC_DERIV")
kernel_env%rho_smooth_id = section_get_ival(xc_section, "XC_GRID%XC_SMOOTH_RHO")
xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
kernel_env%xc_rho1_cflags = xc_functionals_get_needs(functionals=xc_fun_section, lsd=lsd, &
add_basic_components=.TRUE.)
CALL xc_rho_set_create(kernel_env%xc_rho1_set, auxbas_pw_pool%pw_grid%bounds_local, &
rho_cutoff=section_get_rval(xc_section, "DENSITY_CUTOFF"), &
drho_cutoff=section_get_rval(xc_section, "GRADIENT_CUTOFF"), &
tau_cutoff=section_get_rval(xc_section, "TAU_CUTOFF"))
kernel_env%alpha = 1.0_dp
kernel_env%beta = 0.0_dp
! kernel_env%beta is taken into account in spin-restricted case only
IF (nspins == 1) THEN
IF (is_rks_triplets) THEN
! K_{triplets} = K_{alpha,alpha} - K_{alpha,beta}
kernel_env%beta = -1.0_dp
ELSE
! alpha beta
! K_{singlets} = K_{alpha,alpha} + K_{alpha,beta} = 2 * K_{alpha,alpha} + 0 * K_{alpha,beta},
! due to the following relation : K_{alpha,alpha,singlets} == K_{alpha,beta,singlets}
kernel_env%alpha = 2.0_dp
END IF
END IF
! finite differences
kernel_env%deriv2_analytic = section_get_lval(xc_section, "2ND_DERIV_ANALYTICAL")
CALL timestop(handle)
END SUBROUTINE tddfpt_create_kernel_env
! **************************************************************************************************
!> \brief Release kernel environment.
!> \param kernel_env kernel environment (destroyed on exit)
!> \par History
!> * 02.2017 created [Sergey Chulkov]
! **************************************************************************************************
SUBROUTINE tddfpt_release_kernel_env(kernel_env)
TYPE(full_kernel_env_type), POINTER :: kernel_env
IF (ASSOCIATED(kernel_env)) THEN
CALL xc_rho_set_release(kernel_env%xc_rho1_set)
CALL xc_dset_release(kernel_env%xc_deriv_set)
CALL xc_rho_set_release(kernel_env%xc_rho_set)
END IF
END SUBROUTINE tddfpt_release_kernel_env
END MODULE qs_tddfpt2_types

11
src/qs_tddfpt2_utils.F
View file

@ -48,6 +48,7 @@ MODULE qs_tddfpt2_utils
cholesky_dbcsr, cholesky_inverse, cholesky_off, cholesky_restore, oe_gllb, oe_lb, oe_none, &
oe_saop, oe_shift
USE input_section_types, ONLY: section_vals_create,&
section_vals_get,&
section_vals_get_subs_vals,&
section_vals_release,&
section_vals_retain,&
@ -482,19 +483,18 @@ CONTAINS
!> \param qs_env Quickstep environment
!> \param gs_mos ...
!> \param matrix_ks_oep ...
!> \param do_hfx ...
! **************************************************************************************************
SUBROUTINE tddfpt_oecorr(qs_env, gs_mos, matrix_ks_oep, do_hfx)
SUBROUTINE tddfpt_oecorr(qs_env, gs_mos, matrix_ks_oep)
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
POINTER :: gs_mos
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks_oep
LOGICAL, INTENT(IN) :: do_hfx
CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_oecorr'
INTEGER :: handle, iounit, ispin, nao, nmo_occ, &
nspins
LOGICAL :: do_hfx
TYPE(cp_blacs_env_type), POINTER :: blacs_env
TYPE(cp_fm_struct_type), POINTER :: ao_mo_occ_fm_struct, &
mo_occ_mo_occ_fm_struct
@ -502,7 +502,8 @@ CONTAINS
TYPE(cp_logger_type), POINTER :: logger
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks
TYPE(dft_control_type), POINTER :: dft_control
TYPE(section_vals_type), POINTER :: xc_fun_empty, xc_fun_original
TYPE(section_vals_type), POINTER :: hfx_section, xc_fun_empty, &
xc_fun_original
TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
CALL timeset(routineN, handle)
@ -530,6 +531,8 @@ CONTAINS
"Orbital energy correction potential is an experimental feature. "// &
"Use it with extreme care")
hfx_section => section_vals_get_subs_vals(qs_env%input, "DFT%XC%HF")
CALL section_vals_get(hfx_section, explicit=do_hfx)
IF (do_hfx) THEN
CALL cp_abort(__LOCATION__, &
"Implementation of orbital energy correction XC-potentials is "// &

48
src/qs_vxc.F
View file

@ -115,7 +115,8 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'qs_vxc_create'
INTEGER :: handle, ispin, myfun, nelec_spin(2), vdw
INTEGER :: handle, ispin, mspin, myfun, &
nelec_spin(2), vdw
LOGICAL :: compute_virial, do_adiabatic_rescaling, my_just_energy, rho_g_valid, &
sic_scaling_b_zero, tau_r_valid, uf_grid, vdW_nl
REAL(KIND=dp) :: exc_m, factor, &
@ -193,6 +194,10 @@ CONTAINS
CPASSERT(ASSOCIATED(rho_struct))
IF (dft_control%nspins /= 1 .AND. dft_control%nspins /= 2) &
CPABORT("nspins must be 1 or 2")
mspin = SIZE(rho_struct_r)
IF (dft_control%nspins == 2 .AND. mspin == 1) &
CPABORT("Spin count mismatch")
! there are some options related to SIC here.
! Normal DFT computes E(rho_alpha,rho_beta) (or its variant E(2*rho_alpha) for non-LSD)
! SIC can E(rho_alpha,rho_beta)-b*(E(rho_alpha,rho_beta)-E(rho_beta,rho_beta))
@ -228,15 +233,15 @@ CONTAINS
CALL pw_env_get(pw_env, xc_pw_pool=xc_pw_pool, auxbas_pw_pool=auxbas_pw_pool)
uf_grid = .NOT. pw_grid_compare(auxbas_pw_pool%pw_grid, xc_pw_pool%pw_grid)
ALLOCATE (rho_r(dft_control%nspins))
ALLOCATE (rho_r(mspin))
IF (.NOT. uf_grid) THEN
DO ispin = 1, dft_control%nspins
DO ispin = 1, mspin
rho_r(ispin)%pw => rho_struct_r(ispin)%pw
END DO
IF (tau_r_valid) THEN
ALLOCATE (tau(dft_control%nspins))
DO ispin = 1, dft_control%nspins
ALLOCATE (tau(mspin))
DO ispin = 1, mspin
tau(ispin)%pw => tau_struct_r(ispin)%pw
END DO
END IF
@ -244,20 +249,20 @@ CONTAINS
! for gradient corrected functional the density in g space might
! be useful so if we have it, we pass it in
IF (rho_g_valid) THEN
ALLOCATE (rho_g(dft_control%nspins))
DO ispin = 1, dft_control%nspins
ALLOCATE (rho_g(mspin))
DO ispin = 1, mspin
rho_g(ispin)%pw => rho_struct_g(ispin)%pw
END DO
END IF
ELSE
CPASSERT(rho_g_valid)
ALLOCATE (rho_g(dft_control%nspins))
DO ispin = 1, dft_control%nspins
ALLOCATE (rho_g(mspin))
DO ispin = 1, mspin
CALL pw_pool_create_pw(xc_pw_pool, rho_g(ispin)%pw, &
in_space=RECIPROCALSPACE, use_data=COMPLEXDATA1D)
CALL pw_transfer(rho_struct_g(ispin)%pw, rho_g(ispin)%pw)
END DO
DO ispin = 1, dft_control%nspins
DO ispin = 1, mspin
CALL pw_pool_create_pw(xc_pw_pool, rho_r(ispin)%pw, &
in_space=REALSPACE, use_data=REALDATA3D)
CALL pw_transfer(rho_g(ispin)%pw, rho_r(ispin)%pw)
@ -267,10 +272,9 @@ CONTAINS
CPABORT("tau with finer grids")
! ALLOCATE(tau(dft_control%nspins),stat=stat)
! CPPostcondition(stat==0,cp_failure_level,routineP,failure)
! DO ispin=1,dft_control%nspins
! DO ispin=1,mspin
! CALL pw_pool_create_pw(xc_pw_pool,tau(ispin)%pw,&
! in_space=REALSPACE, use_data=REALDATA3D)
!
! CALL pw_pool_create_pw(xc_pw_pool,tmp_g,&
! in_space=RECIPROCALSPACE,use_data=COMPLEXDATA1D)
! CALL pw_pool_create_pw(auxbas_pw_pool,tmp_g2,&
@ -287,7 +291,7 @@ CONTAINS
! add the nlcc densities
IF (ASSOCIATED(rho_nlcc)) THEN
factor = 1.0_dp
DO ispin = 1, dft_control%nspins
DO ispin = 1, mspin
CALL pw_axpy(rho_nlcc%pw, rho_r(ispin)%pw, factor)
CALL pw_axpy(rho_nlcc_g%pw, rho_g(ispin)%pw, factor)
ENDDO
@ -314,7 +318,7 @@ CONTAINS
! remove the nlcc densities (keep stuff in original state)
IF (ASSOCIATED(rho_nlcc)) THEN
factor = -1.0_dp
DO ispin = 1, dft_control%nspins
DO ispin = 1, mspin
CALL pw_axpy(rho_nlcc%pw, rho_r(ispin)%pw, factor)
CALL pw_axpy(rho_nlcc_g%pw, rho_g(ispin)%pw, factor)
ENDDO
@ -367,15 +371,15 @@ CONTAINS
! we have pw data for the xc, qs_ks requests coeff structure, here we transfer
! pw -> coeff
IF (ASSOCIATED(my_vxc_rho)) THEN
ALLOCATE (vxc_rho(dft_control%nspins))
DO ispin = 1, dft_control%nspins
ALLOCATE (vxc_rho(mspin))
DO ispin = 1, mspin
vxc_rho(ispin)%pw => my_vxc_rho(ispin)%pw
END DO
DEALLOCATE (my_vxc_rho)
END IF
IF (ASSOCIATED(my_vxc_tau)) THEN
ALLOCATE (vxc_tau(dft_control%nspins))
DO ispin = 1, dft_control%nspins
ALLOCATE (vxc_tau(mspin))
DO ispin = 1, mspin
vxc_tau(ispin)%pw => my_vxc_tau(ispin)%pw
END DO
DEALLOCATE (my_vxc_tau)
@ -566,7 +570,6 @@ CONTAINS
DO ispin = 1, SIZE(vxc_rho)
CALL pw_pool_create_pw(auxbas_pw_pool, tmp_pw, &
in_space=REALSPACE, use_data=REALDATA3D)
CALL pw_pool_create_pw(xc_pw_pool, tmp_g, &
in_space=RECIPROCALSPACE, use_data=COMPLEXDATA1D)
CALL pw_pool_create_pw(auxbas_pw_pool, tmp_g2, &
@ -576,9 +579,6 @@ CONTAINS
CALL pw_transfer(tmp_g2, tmp_pw)
CALL pw_pool_give_back_pw(auxbas_pw_pool, tmp_g2)
CALL pw_pool_give_back_pw(xc_pw_pool, tmp_g)
!FM CALL pw_zero(tmp_pw)
!FM CALL pw_restrict_s3(vxc_rho(ispin)%pw,tmp_pw,&
!FM auxbas_pw_pool,param_section=interp_section)
CALL pw_pool_give_back_pw(xc_pw_pool, vxc_rho(ispin)%pw)
vxc_rho(ispin)%pw => tmp_pw
NULLIFY (tmp_pw)
@ -588,7 +588,6 @@ CONTAINS
DO ispin = 1, SIZE(vxc_tau)
CALL pw_pool_create_pw(auxbas_pw_pool, tmp_pw, &
in_space=REALSPACE, use_data=REALDATA3D)
CALL pw_pool_create_pw(xc_pw_pool, tmp_g, &
in_space=RECIPROCALSPACE, use_data=COMPLEXDATA1D)
CALL pw_pool_create_pw(auxbas_pw_pool, tmp_g2, &
@ -598,9 +597,6 @@ CONTAINS
CALL pw_transfer(tmp_g2, tmp_pw)
CALL pw_pool_give_back_pw(auxbas_pw_pool, tmp_g2)
CALL pw_pool_give_back_pw(xc_pw_pool, tmp_g)
!FM CALL pw_zero(tmp_pw)
!FM CALL pw_restrict_s3(vxc_rho(ispin)%pw,tmp_pw,&
!FM auxbas_pw_pool,param_section=interp_section)
CALL pw_pool_give_back_pw(xc_pw_pool, vxc_tau(ispin)%pw)
vxc_tau(ispin)%pw => tmp_pw
NULLIFY (tmp_pw)

4
src/qs_wf_history_methods.F
View file

@ -69,14 +69,14 @@ MODULE qs_wf_history_methods
REALSPACE,&
RECIPROCALSPACE,&
pw_p_type
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type,&
set_qs_env
USE qs_ks_types, ONLY: qs_ks_did_change
USE qs_matrix_pools, ONLY: mpools_get,&
qs_matrix_pools_type
USE qs_mo_methods, ONLY: calculate_density_matrix,&
make_basis_cholesky,&
USE qs_mo_methods, ONLY: make_basis_cholesky,&
make_basis_lowdin,&
make_basis_simple,&
make_basis_sm

893
src/response_solver.F
View file

File diff suppressed because it is too large Load diff

2
src/xas_restart.F
View file

@ -47,12 +47,12 @@ MODULE xas_restart
default_string_length,&
dp
USE message_passing, ONLY: mp_bcast
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_environment_types, ONLY: get_qs_env,&
qs_environment_type
USE qs_ks_types, ONLY: qs_ks_did_change
USE qs_mixing_utils, ONLY: mixing_init
USE qs_mo_io, ONLY: wfn_restart_file_name
USE qs_mo_methods, ONLY: calculate_density_matrix
USE qs_mo_occupation, ONLY: set_mo_occupation
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type,&

5
src/xas_tdp_atom.F
View file

@ -1174,6 +1174,11 @@ CONTAINS
dga2 => xas_atom_env%dga2(atom_kind)%array
dgr1 => xas_atom_env%dgr1(atom_kind)%array
dgr2 => xas_atom_env%dgr2(atom_kind)%array
ELSE
dga1 => xas_atom_env%dga1(atom_kind)%array
dga2 => xas_atom_env%dga2(atom_kind)%array
dgr1 => xas_atom_env%dgr1(atom_kind)%array
dgr2 => xas_atom_env%dgr2(atom_kind)%array
END IF
! Need to express the ri_dcoeffs in terms of so (and not sgf)

4
src/xas_tp_scf.F
View file

@ -56,6 +56,7 @@ MODULE xas_tp_scf
init_preconditioner,&
preconditioner_type
USE qs_charges_types, ONLY: qs_charges_type
USE qs_density_matrices, ONLY: calculate_density_matrix
USE qs_density_mixing_types, ONLY: broyden_mixing_new_nr,&
broyden_mixing_nr,&
direct_mixing_nr,&
@ -76,8 +77,7 @@ MODULE xas_tp_scf
localized_wfn_control_type,&
qs_loc_env_new_type
USE qs_mixing_utils, ONLY: self_consistency_check
USE qs_mo_methods, ONLY: calculate_density_matrix,&
calculate_subspace_eigenvalues
USE qs_mo_methods, ONLY: calculate_subspace_eigenvalues
USE qs_mo_occupation, ONLY: set_mo_occupation
USE qs_mo_types, ONLY: get_mo_set,&
mo_set_p_type

1
src/xc/xc_xwpbe.F
View file

@ -200,6 +200,7 @@ CONTAINS
CALL xc_derivative_get(deriv, deriv_data=e_ndrho)
END IF
IF (order >= 2 .OR. order == -2) THEN
CPABORT("derivatives bigger than 1 do not work correctly")
deriv => xc_dset_get_derivative(deriv_set, "(rho)(rho)", &
allocate_deriv=.TRUE.)
CALL xc_derivative_get(deriv, deriv_data=e_rho_rho)

104
src/xtb_coulomb.F
View file

@ -83,7 +83,7 @@ MODULE xtb_coulomb
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xtb_coulomb'
PUBLIC :: build_xtb_coulomb, gamma_rab_sr, xtb_dsint_list
PUBLIC :: build_xtb_coulomb, gamma_rab_sr, dgamma_rab_sr, xtb_dsint_list
CONTAINS
@ -255,52 +255,54 @@ CONTAINS
! 1/R contribution
do_ewald = dft_control%qs_control%xtb_control%do_ewald
IF (do_ewald) THEN
! Ewald sum
NULLIFY (ewald_env, ewald_pw)
CALL get_qs_env(qs_env=qs_env, &
ewald_env=ewald_env, ewald_pw=ewald_pw)
CALL get_cell(cell=cell, periodic=periodic, deth=deth)
CALL ewald_env_get(ewald_env, alpha=alpha, ewald_type=ewald_type)
CALL get_qs_env(qs_env=qs_env, sab_tbe=n_list)
CALL tb_ewald_overlap(gmcharge, mcharge, alpha, n_list, virial, use_virial, atprop)
SELECT CASE (ewald_type)
CASE DEFAULT
CPABORT("Invalid Ewald type")
CASE (do_ewald_none)
CPABORT("Not allowed with DFTB")
CASE (do_ewald_ewald)
CPABORT("Standard Ewald not implemented in DFTB")
CASE (do_ewald_pme)
CPABORT("PME not implemented in DFTB")
CASE (do_ewald_spme)
CALL tb_spme_evaluate(ewald_env, ewald_pw, particle_set, cell, &
gmcharge, mcharge, calculate_forces, virial, use_virial, atprop)
END SELECT
ELSE
! direct sum
CALL get_qs_env(qs_env=qs_env, &
local_particles=local_particles)
DO ikind = 1, SIZE(local_particles%n_el)
DO ia = 1, local_particles%n_el(ikind)
iatom = local_particles%list(ikind)%array(ia)
DO jatom = 1, iatom - 1
rij = particle_set(iatom)%r - particle_set(jatom)%r
rij = pbc(rij, cell)
dr = SQRT(SUM(rij(:)**2))
IF (dr > 1.e-6_dp) THEN
gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge(jatom)/dr
gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge(iatom)/dr
DO i = 2, nmat
gmcharge(iatom, i) = gmcharge(iatom, i) + rij(i - 1)*mcharge(jatom)/dr**3
gmcharge(jatom, i) = gmcharge(jatom, i) - rij(i - 1)*mcharge(iatom)/dr**3
END DO
END IF
IF (dft_control%qs_control%xtb_control%coulomb_lr) THEN
do_ewald = dft_control%qs_control%xtb_control%do_ewald
IF (do_ewald) THEN
! Ewald sum
NULLIFY (ewald_env, ewald_pw)
CALL get_qs_env(qs_env=qs_env, &
ewald_env=ewald_env, ewald_pw=ewald_pw)
CALL get_cell(cell=cell, periodic=periodic, deth=deth)
CALL ewald_env_get(ewald_env, alpha=alpha, ewald_type=ewald_type)
CALL get_qs_env(qs_env=qs_env, sab_tbe=n_list)
CALL tb_ewald_overlap(gmcharge, mcharge, alpha, n_list, virial, use_virial, atprop)
SELECT CASE (ewald_type)
CASE DEFAULT
CPABORT("Invalid Ewald type")
CASE (do_ewald_none)
CPABORT("Not allowed with DFTB")
CASE (do_ewald_ewald)
CPABORT("Standard Ewald not implemented in DFTB")
CASE (do_ewald_pme)
CPABORT("PME not implemented in DFTB")
CASE (do_ewald_spme)
CALL tb_spme_evaluate(ewald_env, ewald_pw, particle_set, cell, &
gmcharge, mcharge, calculate_forces, virial, use_virial, atprop)
END SELECT
ELSE
! direct sum
CALL get_qs_env(qs_env=qs_env, &
local_particles=local_particles)
DO ikind = 1, SIZE(local_particles%n_el)
DO ia = 1, local_particles%n_el(ikind)
iatom = local_particles%list(ikind)%array(ia)
DO jatom = 1, iatom - 1
rij = particle_set(iatom)%r - particle_set(jatom)%r
rij = pbc(rij, cell)
dr = SQRT(SUM(rij(:)**2))
IF (dr > 1.e-6_dp) THEN
gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge(jatom)/dr
gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge(iatom)/dr
DO i = 2, nmat
gmcharge(iatom, i) = gmcharge(iatom, i) + rij(i - 1)*mcharge(jatom)/dr**3
gmcharge(jatom, i) = gmcharge(jatom, i) - rij(i - 1)*mcharge(iatom)/dr**3
END DO
END IF
END DO
END DO
END DO
END DO
CPASSERT(.NOT. use_virial)
CPASSERT(.NOT. use_virial)
END IF
END IF
! global sum of gamma*p arrays
@ -310,11 +312,13 @@ CONTAINS
CALL mp_sum(gmcharge(:, 1), para_env%group)
CALL mp_sum(gchrg(:, :, 1), para_env%group)
IF (do_ewald) THEN
! add self charge interaction and background charge contribution
gmcharge(:, 1) = gmcharge(:, 1) - 2._dp*alpha*oorootpi*mcharge(:)
IF (ANY(periodic(:) == 1)) THEN
gmcharge(:, 1) = gmcharge(:, 1) - pi/alpha**2/deth
IF (dft_control%qs_control%xtb_control%coulomb_lr) THEN
IF (do_ewald) THEN
! add self charge interaction and background charge contribution
gmcharge(:, 1) = gmcharge(:, 1) - 2._dp*alpha*oorootpi*mcharge(:)
IF (ANY(periodic(:) == 1)) THEN
gmcharge(:, 1) = gmcharge(:, 1) - pi/alpha**2/deth
END IF
END IF
END IF

94
src/xtb_ehess.F
View file

@ -171,48 +171,50 @@ CONTAINS
! 1/R contribution
do_ewald = dft_control%qs_control%xtb_control%do_ewald
IF (do_ewald) THEN
! Ewald sum
NULLIFY (ewald_env, ewald_pw)
NULLIFY (virial, atprop)
CALL get_qs_env(qs_env=qs_env, &
ewald_env=ewald_env, ewald_pw=ewald_pw)
CALL get_cell(cell=cell, periodic=periodic, deth=deth)
CALL ewald_env_get(ewald_env, alpha=alpha, ewald_type=ewald_type)
CALL get_qs_env(qs_env=qs_env, sab_tbe=n_list)
CALL tb_ewald_overlap(gmcharge, mcharge1, alpha, n_list, virial, .FALSE., atprop)
SELECT CASE (ewald_type)
CASE DEFAULT
CPABORT("Invalid Ewald type")
CASE (do_ewald_none)
CPABORT("Not allowed with DFTB")
CASE (do_ewald_ewald)
CPABORT("Standard Ewald not implemented in DFTB")
CASE (do_ewald_pme)
CPABORT("PME not implemented in DFTB")
CASE (do_ewald_spme)
CALL tb_spme_evaluate(ewald_env, ewald_pw, particle_set, cell, &
gmcharge, mcharge1, .FALSE., virial, .FALSE., atprop)
END SELECT
ELSE
! direct sum
CALL get_qs_env(qs_env=qs_env, &
local_particles=local_particles)
DO ikind = 1, SIZE(local_particles%n_el)
DO ia = 1, local_particles%n_el(ikind)
iatom = local_particles%list(ikind)%array(ia)
DO jatom = 1, iatom - 1
rij = particle_set(iatom)%r - particle_set(jatom)%r
rij = pbc(rij, cell)
dr = SQRT(SUM(rij(:)**2))
IF (dr > 1.e-6_dp) THEN
gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge1(jatom)/dr
gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge1(iatom)/dr
END IF
IF (dft_control%qs_control%xtb_control%coulomb_lr) THEN
do_ewald = dft_control%qs_control%xtb_control%do_ewald
IF (do_ewald) THEN
! Ewald sum
NULLIFY (ewald_env, ewald_pw)
NULLIFY (virial, atprop)
CALL get_qs_env(qs_env=qs_env, &
ewald_env=ewald_env, ewald_pw=ewald_pw)
CALL get_cell(cell=cell, periodic=periodic, deth=deth)
CALL ewald_env_get(ewald_env, alpha=alpha, ewald_type=ewald_type)
CALL get_qs_env(qs_env=qs_env, sab_tbe=n_list)
CALL tb_ewald_overlap(gmcharge, mcharge1, alpha, n_list, virial, .FALSE., atprop)
SELECT CASE (ewald_type)
CASE DEFAULT
CPABORT("Invalid Ewald type")
CASE (do_ewald_none)
CPABORT("Not allowed with DFTB")
CASE (do_ewald_ewald)
CPABORT("Standard Ewald not implemented in DFTB")
CASE (do_ewald_pme)
CPABORT("PME not implemented in DFTB")
CASE (do_ewald_spme)
CALL tb_spme_evaluate(ewald_env, ewald_pw, particle_set, cell, &
gmcharge, mcharge1, .FALSE., virial, .FALSE., atprop)
END SELECT
ELSE
! direct sum
CALL get_qs_env(qs_env=qs_env, &
local_particles=local_particles)
DO ikind = 1, SIZE(local_particles%n_el)
DO ia = 1, local_particles%n_el(ikind)
iatom = local_particles%list(ikind)%array(ia)
DO jatom = 1, iatom - 1
rij = particle_set(iatom)%r - particle_set(jatom)%r
rij = pbc(rij, cell)
dr = SQRT(SUM(rij(:)**2))
IF (dr > 1.e-6_dp) THEN
gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge1(jatom)/dr
gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge1(iatom)/dr
END IF
END DO
END DO
END DO
END DO
END IF
END IF
! global sum of gamma*p arrays
@ -220,11 +222,13 @@ CONTAINS
CALL mp_sum(gmcharge(:, 1), para_env%group)
CALL mp_sum(gchrg(:, :, 1), para_env%group)
IF (do_ewald) THEN
! add self charge interaction and background charge contribution
gmcharge(:, 1) = gmcharge(:, 1) - 2._dp*alpha*oorootpi*mcharge1(:)
IF (ANY(periodic(:) == 1)) THEN
gmcharge(:, 1) = gmcharge(:, 1) - pi/alpha**2/deth
IF (dft_control%qs_control%xtb_control%coulomb_lr) THEN
IF (do_ewald) THEN
! add self charge interaction and background charge contribution
gmcharge(:, 1) = gmcharge(:, 1) - 2._dp*alpha*oorootpi*mcharge1(:)
IF (ANY(periodic(:) == 1)) THEN
gmcharge(:, 1) = gmcharge(:, 1) - pi/alpha**2/deth
END IF
END IF
END IF

529
src/xtb_ehess_force.F Normal file
View file

@ -0,0 +1,529 @@
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2021 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
!> \brief Calculation of forces for Coulomb contributions in response xTB
!> \author JGH
! **************************************************************************************************
MODULE xtb_ehess_force
USE atomic_kind_types, ONLY: atomic_kind_type,&
get_atomic_kind_set
USE atprop_types, ONLY: atprop_type
USE cell_types, ONLY: cell_type,&
get_cell,&
pbc
USE cp_control_types, ONLY: dft_control_type
USE cp_log_handling, ONLY: cp_get_default_logger,&
cp_logger_get_default_unit_nr,&
cp_logger_type
USE cp_para_types, ONLY: cp_para_env_type
USE dbcsr_api, ONLY: &
dbcsr_add, dbcsr_get_block_p, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, &
dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_p_type, dbcsr_type
USE distribution_1d_types, ONLY: distribution_1d_type
USE ewald_environment_types, ONLY: ewald_env_get,&
ewald_environment_type
USE ewald_methods_tb, ONLY: tb_ewald_overlap,&
tb_spme_zforce
USE ewald_pw_types, ONLY: ewald_pw_type
USE kinds, ONLY: dp
USE mathconstants, ONLY: oorootpi,&
pi
USE message_passing, ONLY: mp_sum
USE particle_types, ONLY: particle_type
USE pw_poisson_types, ONLY: do_ewald_ewald,&
do_ewald_none,&
do_ewald_pme,&
do_ewald_spme
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_neighbor_list_types, ONLY: get_iterator_info,&
neighbor_list_iterate,&
neighbor_list_iterator_create,&
neighbor_list_iterator_p_type,&
neighbor_list_iterator_release,&
neighbor_list_set_p_type
USE qs_rho_types, ONLY: qs_rho_type
USE virial_types, ONLY: virial_type
USE xtb_coulomb, ONLY: dgamma_rab_sr,&
gamma_rab_sr
USE xtb_types, ONLY: get_xtb_atom_param,&
xtb_atom_type
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xtb_ehess_force'
PUBLIC :: calc_xtb_ehess_force
! **************************************************************************************************
CONTAINS
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param matrix_p0 ...
!> \param matrix_p1 ...
!> \param charges0 ...
!> \param mcharge0 ...
!> \param charges1 ...
!> \param mcharge1 ...
!> \param debug_forces ...
! **************************************************************************************************
SUBROUTINE calc_xtb_ehess_force(qs_env, matrix_p0, matrix_p1, charges0, mcharge0, &
charges1, mcharge1, debug_forces)
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_p0, matrix_p1
REAL(KIND=dp), DIMENSION(:, :), INTENT(in) :: charges0
REAL(KIND=dp), DIMENSION(:), INTENT(in) :: mcharge0
REAL(KIND=dp), DIMENSION(:, :), INTENT(in) :: charges1
REAL(KIND=dp), DIMENSION(:), INTENT(in) :: mcharge1
LOGICAL, INTENT(IN) :: debug_forces
CHARACTER(len=*), PARAMETER :: routineN = 'calc_xtb_ehess_force'
INTEGER :: atom_i, atom_j, blk, ewald_type, handle, i, ia, iatom, icol, ikind, iounit, irow, &
j, jatom, jkind, la, lb, lmaxa, lmaxb, natom, natorb_a, natorb_b, ni, nimg, nj, nkind, &
nmat, za, zb
INTEGER, DIMENSION(25) :: laoa, laob
INTEGER, DIMENSION(3) :: cellind, periodic
INTEGER, DIMENSION(:), POINTER :: atom_of_kind, kind_of
LOGICAL :: calculate_forces, defined, do_ewald, &
found, just_energy, use_virial
REAL(KIND=dp) :: alpha, deth, dr, etaa, etab, fi, gmij0, &
gmij1, kg, rcut, rcuta, rcutb
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: xgamma
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: gammab, gcij0, gcij1, gmcharge0, &
gmcharge1
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: gchrg0, gchrg1
REAL(KIND=dp), DIMENSION(3) :: fij, fodeb, rij
REAL(KIND=dp), DIMENSION(5) :: kappaa, kappab
REAL(KIND=dp), DIMENSION(:, :), POINTER :: dsblock, pblock0, pblock1, sblock
TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
TYPE(atprop_type), POINTER :: atprop
TYPE(cell_type), POINTER :: cell
TYPE(cp_logger_type), POINTER :: logger
TYPE(cp_para_env_type), POINTER :: para_env
TYPE(dbcsr_iterator_type) :: iter
TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s
TYPE(dft_control_type), POINTER :: dft_control
TYPE(distribution_1d_type), POINTER :: local_particles
TYPE(ewald_environment_type), POINTER :: ewald_env
TYPE(ewald_pw_type), POINTER :: ewald_pw
TYPE(neighbor_list_iterator_p_type), &
DIMENSION(:), POINTER :: nl_iterator
TYPE(neighbor_list_set_p_type), DIMENSION(:), &
POINTER :: n_list
TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
TYPE(qs_energy_type), POINTER :: energy
TYPE(qs_force_type), DIMENSION(:), POINTER :: force
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
TYPE(qs_rho_type), POINTER :: rho
TYPE(virial_type), POINTER :: virial
TYPE(xtb_atom_type), POINTER :: xtb_atom_a, xtb_atom_b, xtb_kind
CALL timeset(routineN, handle)
logger => cp_get_default_logger()
IF (logger%para_env%ionode) THEN
iounit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
ELSE
iounit = -1
ENDIF
CPASSERT(ASSOCIATED(matrix_p1))
CALL get_qs_env(qs_env, &
qs_kind_set=qs_kind_set, &
particle_set=particle_set, &
cell=cell, &
rho=rho, &
energy=energy, &
virial=virial, &
atprop=atprop, &
dft_control=dft_control)
calculate_forces = .TRUE.
just_energy = .FALSE.
use_virial = .FALSE.
nmat = 4
nimg = dft_control%nimages
IF (nimg > 1) THEN
CPABORT('xTB-sTDA forces for k-points not available')
END IF
CALL get_qs_env(qs_env, nkind=nkind, natom=natom)
ALLOCATE (gchrg0(natom, 5, nmat))
gchrg0 = 0._dp
ALLOCATE (gmcharge0(natom, nmat))
gmcharge0 = 0._dp
ALLOCATE (gchrg1(natom, 5, nmat))
gchrg1 = 0._dp
ALLOCATE (gmcharge1(natom, nmat))
gmcharge1 = 0._dp
! short range contribution (gamma)
! loop over all atom pairs with a non-zero overlap (sab_orb)
kg = dft_control%qs_control%xtb_control%kg
NULLIFY (n_list)
CALL get_qs_env(qs_env=qs_env, sab_orb=n_list)
CALL neighbor_list_iterator_create(nl_iterator, n_list)
DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, &
iatom=iatom, jatom=jatom, r=rij, cell=cellind)
CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_atom_a)
CALL get_xtb_atom_param(xtb_atom_a, defined=defined, natorb=natorb_a)
IF (.NOT. defined .OR. natorb_a < 1) CYCLE
CALL get_qs_kind(qs_kind_set(jkind), xtb_parameter=xtb_atom_b)
CALL get_xtb_atom_param(xtb_atom_b, defined=defined, natorb=natorb_b)
IF (.NOT. defined .OR. natorb_b < 1) CYCLE
! atomic parameters
CALL get_xtb_atom_param(xtb_atom_a, eta=etaa, lmax=lmaxa, kappa=kappaa, rcut=rcuta)
CALL get_xtb_atom_param(xtb_atom_b, eta=etab, lmax=lmaxb, kappa=kappab, rcut=rcutb)
! gamma matrix
ni = lmaxa + 1
nj = lmaxb + 1
ALLOCATE (gammab(ni, nj))
rcut = rcuta + rcutb
dr = SQRT(SUM(rij(:)**2))
CALL gamma_rab_sr(gammab, dr, ni, kappaa, etaa, nj, kappab, etab, kg, rcut)
gchrg0(iatom, 1:ni, 1) = gchrg0(iatom, 1:ni, 1) + MATMUL(gammab, charges0(jatom, 1:nj))
gchrg1(iatom, 1:ni, 1) = gchrg1(iatom, 1:ni, 1) + MATMUL(gammab, charges1(jatom, 1:nj))
IF (iatom /= jatom) THEN
gchrg0(jatom, 1:nj, 1) = gchrg0(jatom, 1:nj, 1) + MATMUL(charges0(iatom, 1:ni), gammab)
gchrg1(jatom, 1:nj, 1) = gchrg1(jatom, 1:nj, 1) + MATMUL(charges1(iatom, 1:ni), gammab)
END IF
IF (dr > 1.e-6_dp) THEN
CALL dgamma_rab_sr(gammab, dr, ni, kappaa, etaa, nj, kappab, etab, kg, rcut)
DO i = 1, 3
gchrg0(iatom, 1:ni, i + 1) = gchrg0(iatom, 1:ni, i + 1) &
+ MATMUL(gammab, charges0(jatom, 1:nj))*rij(i)/dr
gchrg1(iatom, 1:ni, i + 1) = gchrg1(iatom, 1:ni, i + 1) &
+ MATMUL(gammab, charges1(jatom, 1:nj))*rij(i)/dr
IF (iatom /= jatom) THEN
gchrg0(jatom, 1:nj, i + 1) = gchrg0(jatom, 1:nj, i + 1) &
- MATMUL(charges0(iatom, 1:ni), gammab)*rij(i)/dr
gchrg1(jatom, 1:nj, i + 1) = gchrg1(jatom, 1:nj, i + 1) &
- MATMUL(charges1(iatom, 1:ni), gammab)*rij(i)/dr
END IF
END DO
END IF
DEALLOCATE (gammab)
END DO
CALL neighbor_list_iterator_release(nl_iterator)
! 1/R contribution
IF (dft_control%qs_control%xtb_control%coulomb_lr) THEN
do_ewald = dft_control%qs_control%xtb_control%do_ewald
IF (do_ewald) THEN
! Ewald sum
NULLIFY (ewald_env, ewald_pw)
CALL get_qs_env(qs_env=qs_env, &
ewald_env=ewald_env, ewald_pw=ewald_pw)
CALL get_cell(cell=cell, periodic=periodic, deth=deth)
CALL ewald_env_get(ewald_env, alpha=alpha, ewald_type=ewald_type)
CALL get_qs_env(qs_env=qs_env, sab_tbe=n_list)
CALL tb_ewald_overlap(gmcharge0, mcharge0, alpha, n_list, virial, use_virial, atprop)
CALL tb_ewald_overlap(gmcharge1, mcharge1, alpha, n_list, virial, use_virial, atprop)
SELECT CASE (ewald_type)
CASE DEFAULT
CPABORT("Invalid Ewald type")
CASE (do_ewald_none)
CPABORT("Not allowed with DFTB")
CASE (do_ewald_ewald)
CPABORT("Standard Ewald not implemented in DFTB")
CASE (do_ewald_pme)
CPABORT("PME not implemented in DFTB")
CASE (do_ewald_spme)
CALL tb_spme_zforce(ewald_env, ewald_pw, particle_set, cell, gmcharge0, mcharge0)
CALL tb_spme_zforce(ewald_env, ewald_pw, particle_set, cell, gmcharge1, mcharge1)
END SELECT
ELSE
! direct sum
CALL get_qs_env(qs_env=qs_env, local_particles=local_particles)
DO ikind = 1, SIZE(local_particles%n_el)
DO ia = 1, local_particles%n_el(ikind)
iatom = local_particles%list(ikind)%array(ia)
DO jatom = 1, iatom - 1
rij = particle_set(iatom)%r - particle_set(jatom)%r
rij = pbc(rij, cell)
dr = SQRT(SUM(rij(:)**2))
IF (dr > 1.e-6_dp) THEN
gmcharge0(iatom, 1) = gmcharge0(iatom, 1) + mcharge0(jatom)/dr
gmcharge0(jatom, 1) = gmcharge0(jatom, 1) + mcharge0(iatom)/dr
gmcharge1(iatom, 1) = gmcharge1(iatom, 1) + mcharge1(jatom)/dr
gmcharge1(jatom, 1) = gmcharge1(jatom, 1) + mcharge1(iatom)/dr
DO i = 2, nmat
gmcharge0(iatom, i) = gmcharge0(iatom, i) + rij(i - 1)*mcharge0(jatom)/dr**3
gmcharge0(jatom, i) = gmcharge0(jatom, i) - rij(i - 1)*mcharge0(iatom)/dr**3
gmcharge1(iatom, i) = gmcharge1(iatom, i) + rij(i - 1)*mcharge1(jatom)/dr**3
gmcharge1(jatom, i) = gmcharge1(jatom, i) - rij(i - 1)*mcharge1(iatom)/dr**3
END DO
END IF
END DO
END DO
END DO
CPASSERT(.NOT. use_virial)
END IF
END IF
! global sum of gamma*p arrays
CALL get_qs_env(qs_env=qs_env, &
atomic_kind_set=atomic_kind_set, &
force=force, para_env=para_env)
CALL mp_sum(gmcharge0(:, 1), para_env%group)
CALL mp_sum(gchrg0(:, :, 1), para_env%group)
CALL mp_sum(gmcharge1(:, 1), para_env%group)
CALL mp_sum(gchrg1(:, :, 1), para_env%group)
IF (dft_control%qs_control%xtb_control%coulomb_lr) THEN
IF (do_ewald) THEN
! add self charge interaction and background charge contribution
gmcharge0(:, 1) = gmcharge0(:, 1) - 2._dp*alpha*oorootpi*mcharge0(:)
IF (ANY(periodic(:) == 1)) THEN
gmcharge0(:, 1) = gmcharge0(:, 1) - pi/alpha**2/deth
END IF
gmcharge1(:, 1) = gmcharge1(:, 1) - 2._dp*alpha*oorootpi*mcharge1(:)
IF (ANY(periodic(:) == 1)) THEN
gmcharge1(:, 1) = gmcharge1(:, 1) - pi/alpha**2/deth
END IF
END IF
END IF
ALLOCATE (atom_of_kind(natom), kind_of(natom))
CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, &
kind_of=kind_of, &
atom_of_kind=atom_of_kind)
IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
DO iatom = 1, natom
ikind = kind_of(iatom)
atom_i = atom_of_kind(iatom)
CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_kind)
CALL get_xtb_atom_param(xtb_kind, lmax=ni)
ni = ni + 1
! short range
fij = 0.0_dp
DO i = 1, 3
fij(i) = SUM(charges0(iatom, 1:ni)*gchrg1(iatom, 1:ni, i + 1)) + &
SUM(charges1(iatom, 1:ni)*gchrg0(iatom, 1:ni, i + 1))
END DO
force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - fij(1)
force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - fij(2)
force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - fij(3)
! long range
fij = 0.0_dp
DO i = 1, 3
fij(i) = gmcharge1(iatom, i + 1)*mcharge0(iatom) + &
gmcharge0(iatom, i + 1)*mcharge1(iatom)
END DO
force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - fij(1)
force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - fij(2)
force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - fij(3)
END DO
IF (debug_forces) THEN
fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
CALL mp_sum(fodeb, para_env%group)
IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: P*dH[Pz] ", fodeb
END IF
CALL get_qs_env(qs_env=qs_env, matrix_s_kp=matrix_s)
IF (SIZE(matrix_p0) == 2) THEN
CALL dbcsr_add(matrix_p0(1)%matrix, matrix_p0(2)%matrix, &
alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
CALL dbcsr_add(matrix_p1(1)%matrix, matrix_p1(2)%matrix, &
alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
END IF
! no k-points; all matrices have been transformed to periodic bsf
IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
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(irow)
jkind = kind_of(icol)
! atomic parameters
CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_atom_a)
CALL get_qs_kind(qs_kind_set(jkind), xtb_parameter=xtb_atom_b)
CALL get_xtb_atom_param(xtb_atom_a, z=za, lao=laoa)
CALL get_xtb_atom_param(xtb_atom_b, z=zb, lao=laob)
ni = SIZE(sblock, 1)
nj = SIZE(sblock, 2)
ALLOCATE (gcij0(ni, nj))
ALLOCATE (gcij1(ni, nj))
DO i = 1, ni
DO j = 1, nj
la = laoa(i) + 1
lb = laob(j) + 1
gcij0(i, j) = 0.5_dp*(gchrg0(irow, la, 1) + gchrg0(icol, lb, 1))
gcij1(i, j) = 0.5_dp*(gchrg1(irow, la, 1) + gchrg1(icol, lb, 1))
END DO
END DO
gmij0 = 0.5_dp*(gmcharge0(irow, 1) + gmcharge0(icol, 1))
gmij1 = 0.5_dp*(gmcharge1(irow, 1) + gmcharge1(icol, 1))
atom_i = atom_of_kind(irow)
atom_j = atom_of_kind(icol)
NULLIFY (pblock0)
CALL dbcsr_get_block_p(matrix=matrix_p0(1)%matrix, &
row=irow, col=icol, block=pblock0, found=found)
CPASSERT(found)
NULLIFY (pblock1)
CALL dbcsr_get_block_p(matrix=matrix_p1(1)%matrix, &
row=irow, col=icol, block=pblock1, found=found)
CPASSERT(found)
DO i = 1, 3
NULLIFY (dsblock)
CALL dbcsr_get_block_p(matrix=matrix_s(1 + i, 1)%matrix, &
row=irow, col=icol, block=dsblock, found=found)
CPASSERT(found)
! short range
fi = -2.0_dp*SUM(pblock0*dsblock*gcij1) - 2.0_dp*SUM(pblock1*dsblock*gcij0)
force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi
force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi
! long range
fi = -2.0_dp*gmij1*SUM(pblock0*dsblock) - 2.0_dp*gmij0*SUM(pblock1*dsblock)
force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi
force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi
END DO
DEALLOCATE (gcij0, gcij1)
ENDDO
CALL dbcsr_iterator_stop(iter)
IF (debug_forces) THEN
fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
CALL mp_sum(fodeb, para_env%group)
IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Pz*H[P]*dS ", fodeb
END IF
IF (dft_control%qs_control%xtb_control%tb3_interaction) THEN
CALL get_qs_env(qs_env, nkind=nkind)
ALLOCATE (xgamma(nkind))
DO ikind = 1, nkind
CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_kind)
CALL get_xtb_atom_param(xtb_kind, xgamma=xgamma(ikind))
END DO
! Diagonal 3rd order correction (DFTB3)
IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
CALL dftb3_diagonal_hessian_force(qs_env, mcharge0, mcharge1, &
matrix_p0(1)%matrix, matrix_p1(1)%matrix, xgamma)
IF (debug_forces) THEN
fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
CALL mp_sum(fodeb, para_env%group)
IF (iounit > 0) WRITE (iounit, "(T3,A,T33,3F16.8)") "DEBUG:: Pz*H3[P] ", fodeb
END IF
DEALLOCATE (xgamma)
END IF
IF (SIZE(matrix_p0) == 2) THEN
CALL dbcsr_add(matrix_p0(1)%matrix, matrix_p0(2)%matrix, &
alpha_scalar=1.0_dp, beta_scalar=-1.0_dp)
CALL dbcsr_add(matrix_p1(1)%matrix, matrix_p1(2)%matrix, &
alpha_scalar=1.0_dp, beta_scalar=-1.0_dp)
END IF
! QMMM
IF (qs_env%qmmm .AND. qs_env%qmmm_periodic) THEN
CPABORT("Not Available")
END IF
DEALLOCATE (gmcharge0, gchrg0, gmcharge1, gchrg1)
DEALLOCATE (atom_of_kind, kind_of)
CALL timestop(handle)
END SUBROUTINE calc_xtb_ehess_force
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param mcharge0 ...
!> \param mcharge1 ...
!> \param matrixp0 ...
!> \param matrixp1 ...
!> \param xgamma ...
! **************************************************************************************************
SUBROUTINE dftb3_diagonal_hessian_force(qs_env, mcharge0, mcharge1, &
matrixp0, matrixp1, xgamma)
TYPE(qs_environment_type), POINTER :: qs_env
REAL(dp), DIMENSION(:) :: mcharge0, mcharge1
TYPE(dbcsr_type), POINTER :: matrixp0, matrixp1
REAL(dp), DIMENSION(:) :: xgamma
CHARACTER(len=*), PARAMETER :: routineN = 'dftb3_diagonal_hessian_force'
INTEGER :: atom_i, atom_j, blk, handle, i, icol, &
ikind, irow, jkind, natom
INTEGER, DIMENSION(:), POINTER :: atom_of_kind, kind_of
LOGICAL :: found
REAL(KIND=dp) :: fi, gmijp, gmijq, ui, uj
REAL(KIND=dp), DIMENSION(:, :), POINTER :: dsblock, p0block, p1block, sblock
TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
TYPE(dbcsr_iterator_type) :: iter
TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
TYPE(qs_force_type), DIMENSION(:), POINTER :: force
CALL timeset(routineN, handle)
CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s, natom=natom)
ALLOCATE (atom_of_kind(natom), kind_of(natom))
CALL get_qs_env(qs_env=qs_env, atomic_kind_set=atomic_kind_set)
CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, &
kind_of=kind_of, atom_of_kind=atom_of_kind)
CALL get_qs_env(qs_env=qs_env, force=force)
! no k-points; all matrices have been transformed to periodic bsf
CALL dbcsr_iterator_start(iter, matrix_s(1)%matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, irow, icol, sblock, blk)
ikind = kind_of(irow)
atom_i = atom_of_kind(irow)
ui = xgamma(ikind)
jkind = kind_of(icol)
atom_j = atom_of_kind(icol)
uj = xgamma(jkind)
!
gmijp = ui*mcharge0(irow)*mcharge1(irow) + uj*mcharge0(icol)*mcharge1(icol)
gmijq = 0.5_dp*ui*mcharge0(irow)**2 + 0.5_dp*uj*mcharge0(icol)**2
!
NULLIFY (p0block)
CALL dbcsr_get_block_p(matrix=matrixp0, &
row=irow, col=icol, block=p0block, found=found)
CPASSERT(found)
NULLIFY (p1block)
CALL dbcsr_get_block_p(matrix=matrixp1, &
row=irow, col=icol, block=p1block, found=found)
CPASSERT(found)
DO i = 1, 3
NULLIFY (dsblock)
CALL dbcsr_get_block_p(matrix=matrix_s(1 + i)%matrix, &
row=irow, col=icol, block=dsblock, found=found)
CPASSERT(found)
fi = gmijp*SUM(p0block*dsblock) + gmijq*SUM(p1block*dsblock)
force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi
force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi
END DO
ENDDO
CALL dbcsr_iterator_stop(iter)
DEALLOCATE (atom_of_kind, kind_of)
CALL timestop(handle)
END SUBROUTINE dftb3_diagonal_hessian_force
END MODULE xtb_ehess_force

562
src/xtb_matrices.F
View file

@ -28,7 +28,8 @@ MODULE xtb_matrices
USE cp_control_types, ONLY: dft_control_type,&
xtb_control_type
USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set
USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set,&
dbcsr_deallocate_matrix_set
USE cp_dbcsr_output, ONLY: cp_dbcsr_write_sparse_matrix
USE cp_log_handling, ONLY: cp_get_default_logger,&
cp_logger_get_default_io_unit,&
@ -121,7 +122,7 @@ MODULE xtb_matrices
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xtb_matrices'
PUBLIC :: build_xtb_matrices, build_xtb_ks_matrix
PUBLIC :: build_xtb_matrices, build_xtb_ks_matrix, xtb_hab_force
CONTAINS
@ -981,6 +982,563 @@ CONTAINS
END SUBROUTINE build_xtb_matrices
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...
!> \param p_matrix ...
! **************************************************************************************************
SUBROUTINE xtb_hab_force(qs_env, p_matrix)
TYPE(qs_environment_type), POINTER :: qs_env
TYPE(dbcsr_type), POINTER :: p_matrix
CHARACTER(LEN=*), PARAMETER :: routineN = 'xtb_hab_force', routineP = moduleN//':'//routineN
INTEGER :: atom_a, atom_b, atom_c, handle, i, iatom, ic, icol, ikind, img, ir, irow, iset, &
j, jatom, jkind, jset, katom, kkind, la, lb, ldsab, lmaxa, lmaxb, maxder, maxs, n1, n2, &
na, natom, natorb_a, natorb_b, nb, ncoa, ncob, nderivatives, nimg, nkind, nsa, nsb, &
nseta, nsetb, nshell, sgfa, sgfb, za, zb
INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_of_kind, atomnumber, kind_of
INTEGER, DIMENSION(25) :: laoa, laob, lval, naoa, naob
INTEGER, DIMENSION(3) :: cell
INTEGER, DIMENSION(:), POINTER :: la_max, la_min, lb_max, lb_min, npgfa, &
npgfb, nsgfa, nsgfb
INTEGER, DIMENSION(:, :), POINTER :: first_sgfa, first_sgfb
LOGICAL :: defined, diagblock, floating_a, found, &
ghost_a, use_virial, xb_inter
LOGICAL, ALLOCATABLE, DIMENSION(:) :: floating, ghost
REAL(KIND=dp) :: alphaa, alphab, dfp, dhij, dr, drk, drx, ena, enb, etaa, etab, f0, fen, &
fhua, fhub, fhud, foab, hij, k2sh, kab, kcnd, kcnp, kcns, kd, ken, kf, kg, kia, kjb, kp, &
ks, ksp, kx2, kxr, rcova, rcovab, rcovb, rrab, zneffa, zneffb
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: cnumbers
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: dfblock, huckel, kcnlk, owork
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: oint, sint
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :, :) :: kijab
REAL(KIND=dp), DIMENSION(0:3) :: kl
REAL(KIND=dp), DIMENSION(3) :: fdik, fdika, fdikb, force_ab, rij, rik
REAL(KIND=dp), DIMENSION(5) :: dpia, dpib, hena, henb, kappaa, kappab, &
kpolya, kpolyb, pia, pib
REAL(KIND=dp), DIMENSION(:), POINTER :: set_radius_a, set_radius_b
REAL(KIND=dp), DIMENSION(:, :), POINTER :: fblock, pblock, rpgfa, rpgfb, sblock, &
scon_a, scon_b, zeta, zetb
TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
TYPE(block_p_type), DIMENSION(2:4) :: dsblocks
TYPE(cp_logger_type), POINTER :: logger
TYPE(cp_para_env_type), POINTER :: para_env
TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_h, matrix_s
TYPE(dcnum_type), ALLOCATABLE, DIMENSION(:) :: dcnum
TYPE(dft_control_type), POINTER :: dft_control
TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: basis_set_list
TYPE(gto_basis_set_type), POINTER :: basis_set_a, basis_set_b
TYPE(neighbor_atoms_type), ALLOCATABLE, &
DIMENSION(:) :: neighbor_atoms
TYPE(neighbor_list_iterator_p_type), &
DIMENSION(:), POINTER :: nl_iterator
TYPE(neighbor_list_set_p_type), DIMENSION(:), &
POINTER :: sab_orb
TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
TYPE(qs_dispersion_type), POINTER :: dispersion_env
TYPE(qs_force_type), DIMENSION(:), POINTER :: force
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
TYPE(qs_ks_env_type), POINTER :: ks_env
TYPE(xtb_atom_type), POINTER :: xtb_atom_a, xtb_atom_b
TYPE(xtb_control_type), POINTER :: xtb_control
CALL timeset(routineN, handle)
NULLIFY (logger)
logger => cp_get_default_logger()
NULLIFY (matrix_h, matrix_s, atomic_kind_set, qs_kind_set, sab_orb)
CALL get_qs_env(qs_env=qs_env, &
atomic_kind_set=atomic_kind_set, &
qs_kind_set=qs_kind_set, &
dft_control=dft_control, &
para_env=para_env, &
sab_orb=sab_orb)
nkind = SIZE(atomic_kind_set)
xtb_control => dft_control%qs_control%xtb_control
nimg = dft_control%nimages
nderivatives = 1
maxder = ncoset(nderivatives)
! global parameters (Table 2 from Ref.)
ks = xtb_control%ks
kp = xtb_control%kp
kd = xtb_control%kd
ksp = xtb_control%ksp
k2sh = xtb_control%k2sh
kg = xtb_control%kg
kf = xtb_control%kf
kcns = xtb_control%kcns
kcnp = xtb_control%kcnp
kcnd = xtb_control%kcnd
ken = xtb_control%ken
kxr = xtb_control%kxr
kx2 = xtb_control%kx2
NULLIFY (particle_set)
CALL get_qs_env(qs_env=qs_env, particle_set=particle_set)
natom = SIZE(particle_set)
ALLOCATE (atom_of_kind(natom))
CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, atom_of_kind=atom_of_kind)
CALL get_qs_kind_set(qs_kind_set=qs_kind_set, maxsgf=maxs, basis_type="ORB")
NULLIFY (force)
CALL get_qs_env(qs_env=qs_env, force=force)
use_virial = .FALSE.
CPASSERT(nimg == 1)
! set up basis set lists
ALLOCATE (basis_set_list(nkind))
CALL basis_set_list_setup(basis_set_list, "ORB", qs_kind_set)
! allocate overlap matrix
CALL get_qs_env(qs_env=qs_env, ks_env=ks_env)
CALL dbcsr_allocate_matrix_set(matrix_s, maxder, nimg)
CALL create_sab_matrix(ks_env, matrix_s, "xTB OVERLAP MATRIX", basis_set_list, basis_set_list, &
sab_orb, .TRUE.)
! initialize H matrix
CALL dbcsr_allocate_matrix_set(matrix_h, 1, nimg)
DO img = 1, nimg
ALLOCATE (matrix_h(1, img)%matrix)
CALL dbcsr_create(matrix_h(1, img)%matrix, template=matrix_s(1, 1)%matrix, &
name="HAMILTONIAN MATRIX")
CALL cp_dbcsr_alloc_block_from_nbl(matrix_h(1, img)%matrix, sab_orb)
END DO
! Calculate coordination numbers
! needed for effective atomic energy levels (Eq. 12)
! code taken from D3 dispersion energy
ALLOCATE (cnumbers(natom))
cnumbers = 0._dp
ALLOCATE (dcnum(natom))
dcnum(:)%neighbors = 0
DO iatom = 1, natom
ALLOCATE (dcnum(iatom)%nlist(10), dcnum(iatom)%dvals(10), dcnum(iatom)%rik(3, 10))
END DO
ALLOCATE (ghost(nkind), floating(nkind), atomnumber(nkind))
DO ikind = 1, nkind
CALL get_atomic_kind(atomic_kind_set(ikind), z=za)
CALL get_qs_kind(qs_kind_set(ikind), ghost=ghost_a, floating=floating_a)
ghost(ikind) = ghost_a
floating(ikind) = floating_a
atomnumber(ikind) = za
END DO
CALL get_qs_env(qs_env=qs_env, dispersion_env=dispersion_env)
CALL d3_cnumber(qs_env, dispersion_env, cnumbers, dcnum, ghost, floating, atomnumber, &
.TRUE., .FALSE.)
DEALLOCATE (ghost, floating, atomnumber)
CALL mp_sum(cnumbers, para_env%group)
CALL dcnum_distribute(dcnum, para_env)
! Calculate Huckel parameters
! Eq 12
! huckel(nshell,natom)
ALLOCATE (kcnlk(0:3, nkind))
DO ikind = 1, nkind
CALL get_atomic_kind(atomic_kind_set(ikind), z=za)
IF (metal(za)) THEN
kcnlk(0:3, ikind) = 0.0_dp
ELSEIF (early3d(za)) THEN
kcnlk(0, ikind) = kcns
kcnlk(1, ikind) = kcnp
kcnlk(2, ikind) = 0.005_dp
kcnlk(3, ikind) = 0.0_dp
ELSE
kcnlk(0, ikind) = kcns
kcnlk(1, ikind) = kcnp
kcnlk(2, ikind) = kcnd
kcnlk(3, ikind) = 0.0_dp
END IF
END DO
ALLOCATE (huckel(5, natom), kind_of(natom))
CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, kind_of=kind_of)
DO iatom = 1, natom
ikind = kind_of(iatom)
CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_atom_a)
CALL get_xtb_atom_param(xtb_atom_a, nshell=nshell, lval=lval, hen=hena)
huckel(:, iatom) = 0.0_dp
DO i = 1, nshell
huckel(i, iatom) = hena(i)*(1._dp + kcnlk(lval(i), ikind)*cnumbers(iatom))
END DO
END DO
! Calculate KAB parameters and Huckel parameters and electronegativity correction
kl(0) = ks
kl(1) = kp
kl(2) = kd
kl(3) = 0.0_dp
ALLOCATE (kijab(maxs, maxs, nkind, nkind))
kijab = 0.0_dp
DO ikind = 1, nkind
CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_atom_a)
CALL get_xtb_atom_param(xtb_atom_a, defined=defined, natorb=natorb_a)
IF (.NOT. defined .OR. natorb_a < 1) CYCLE
CALL get_xtb_atom_param(xtb_atom_a, z=za, nao=naoa, lao=laoa, electronegativity=ena)
DO jkind = 1, nkind
CALL get_qs_kind(qs_kind_set(jkind), xtb_parameter=xtb_atom_b)
CALL get_xtb_atom_param(xtb_atom_b, defined=defined, natorb=natorb_b)
IF (.NOT. defined .OR. natorb_b < 1) CYCLE
CALL get_xtb_atom_param(xtb_atom_b, z=zb, nao=naob, lao=laob, electronegativity=enb)
! get Fen = (1+ken*deltaEN^2)
fen = 1.0_dp + ken*(ena - enb)**2
! Kab
kab = xtb_set_kab(za, zb, xtb_control)
DO j = 1, natorb_b
lb = laob(j)
nb = naob(j)
DO i = 1, natorb_a
la = laoa(i)
na = naoa(i)
kia = kl(la)
kjb = kl(lb)
IF (zb == 1 .AND. nb == 2) kjb = k2sh
IF (za == 1 .AND. na == 2) kia = k2sh
IF ((zb == 1 .AND. nb == 2) .OR. (za == 1 .AND. na == 2)) THEN
kijab(i, j, ikind, jkind) = 0.5_dp*(kia + kjb)
ELSE
IF ((la == 0 .AND. lb == 1) .OR. (la == 1 .AND. lb == 0)) THEN
kijab(i, j, ikind, jkind) = ksp*kab*fen
ELSE
kijab(i, j, ikind, jkind) = 0.5_dp*(kia + kjb)*kab*fen
END IF
END IF
END DO
END DO
END DO
END DO
! loop over all atom pairs with a non-zero overlap (sab_orb)
CALL neighbor_list_iterator_create(nl_iterator, sab_orb)
DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, &
iatom=iatom, jatom=jatom, r=rij, cell=cell)
CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_atom_a)
CALL get_xtb_atom_param(xtb_atom_a, defined=defined, natorb=natorb_a)
IF (.NOT. defined .OR. natorb_a < 1) CYCLE
CALL get_qs_kind(qs_kind_set(jkind), xtb_parameter=xtb_atom_b)
CALL get_xtb_atom_param(xtb_atom_b, defined=defined, natorb=natorb_b)
IF (.NOT. defined .OR. natorb_b < 1) CYCLE
dr = SQRT(SUM(rij(:)**2))
! neighbor atom for XB term
IF (xb_inter .AND. (dr > 1.e-3_dp)) THEN
IF (ASSOCIATED(neighbor_atoms(ikind)%rab)) THEN
atom_a = atom_of_kind(iatom)
IF (dr < neighbor_atoms(ikind)%rab(atom_a)) THEN
neighbor_atoms(ikind)%rab(atom_a) = dr
neighbor_atoms(ikind)%coord(1:3, atom_a) = rij(1:3)
neighbor_atoms(ikind)%katom(atom_a) = jatom
END IF
END IF
IF (ASSOCIATED(neighbor_atoms(jkind)%rab)) THEN
atom_b = atom_of_kind(jatom)
IF (dr < neighbor_atoms(jkind)%rab(atom_b)) THEN
neighbor_atoms(jkind)%rab(atom_b) = dr
neighbor_atoms(jkind)%coord(1:3, atom_b) = -rij(1:3)
neighbor_atoms(jkind)%katom(atom_b) = iatom
END IF
END IF
END IF
! atomic parameters
CALL get_xtb_atom_param(xtb_atom_a, z=za, nao=naoa, lao=laoa, rcov=rcova, eta=etaa, &
lmax=lmaxa, nshell=nsa, alpha=alphaa, zneff=zneffa, kpoly=kpolya, &
kappa=kappaa, hen=hena)
CALL get_xtb_atom_param(xtb_atom_b, z=zb, nao=naob, lao=laob, rcov=rcovb, eta=etab, &
lmax=lmaxb, nshell=nsb, alpha=alphab, zneff=zneffb, kpoly=kpolyb, &
kappa=kappab, hen=henb)
ic = 1
icol = MAX(iatom, jatom)
irow = MIN(iatom, jatom)
NULLIFY (sblock, fblock)
CALL dbcsr_get_block_p(matrix=matrix_s(1, ic)%matrix, &
row=irow, col=icol, BLOCK=sblock, found=found)
CPASSERT(found)
CALL dbcsr_get_block_p(matrix=matrix_h(1, ic)%matrix, &
row=irow, col=icol, BLOCK=fblock, found=found)
CPASSERT(found)
NULLIFY (pblock)
CALL dbcsr_get_block_p(matrix=p_matrix, &
row=irow, col=icol, block=pblock, found=found)
CPASSERT(ASSOCIATED(pblock))
DO i = 2, 4
NULLIFY (dsblocks(i)%block)
CALL dbcsr_get_block_p(matrix=matrix_s(i, ic)%matrix, &
row=irow, col=icol, BLOCK=dsblocks(i)%block, found=found)
CPASSERT(found)
END DO
! overlap
basis_set_a => basis_set_list(ikind)%gto_basis_set
IF (.NOT. ASSOCIATED(basis_set_a)) CYCLE
basis_set_b => basis_set_list(jkind)%gto_basis_set
IF (.NOT. ASSOCIATED(basis_set_b)) CYCLE
atom_a = atom_of_kind(iatom)
atom_b = atom_of_kind(jatom)
! basis ikind
first_sgfa => basis_set_a%first_sgf
la_max => basis_set_a%lmax
la_min => basis_set_a%lmin
npgfa => basis_set_a%npgf
nseta = basis_set_a%nset
nsgfa => basis_set_a%nsgf_set
rpgfa => basis_set_a%pgf_radius
set_radius_a => basis_set_a%set_radius
scon_a => basis_set_a%scon
zeta => basis_set_a%zet
! basis jkind
first_sgfb => basis_set_b%first_sgf
lb_max => basis_set_b%lmax
lb_min => basis_set_b%lmin
npgfb => basis_set_b%npgf
nsetb = basis_set_b%nset
nsgfb => basis_set_b%nsgf_set
rpgfb => basis_set_b%pgf_radius
set_radius_b => basis_set_b%set_radius
scon_b => basis_set_b%scon
zetb => basis_set_b%zet
ldsab = get_memory_usage(qs_kind_set, "ORB", "ORB")
ALLOCATE (oint(ldsab, ldsab, maxder), owork(ldsab, ldsab))
ALLOCATE (sint(natorb_a, natorb_b, maxder))
sint = 0.0_dp
DO iset = 1, nseta
ncoa = npgfa(iset)*ncoset(la_max(iset))
n1 = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1))
sgfa = first_sgfa(1, iset)
DO jset = 1, nsetb
IF (set_radius_a(iset) + set_radius_b(jset) < dr) CYCLE
ncob = npgfb(jset)*ncoset(lb_max(jset))
n2 = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1))
sgfb = first_sgfb(1, jset)
CALL overlap_ab(la_max(iset), la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), &
lb_max(jset), lb_min(jset), npgfb(jset), rpgfb(:, jset), zetb(:, jset), &
rij, sab=oint(:, :, 1), dab=oint(:, :, 2:4))
! Contraction
DO i = 1, 4
CALL contraction(oint(:, :, i), owork, ca=scon_a(:, sgfa:), na=n1, ma=nsgfa(iset), &
cb=scon_b(:, sgfb:), nb=n2, mb=nsgfb(jset), fscale=1.0_dp, trans=.FALSE.)
CALL block_add("IN", owork, nsgfa(iset), nsgfb(jset), sint(:, :, i), sgfa, sgfb, trans=.FALSE.)
END DO
END DO
END DO
! update S matrix
IF (iatom <= jatom) THEN
sblock(:, :) = sblock(:, :) + sint(:, :, 1)
ELSE
sblock(:, :) = sblock(:, :) + TRANSPOSE(sint(:, :, 1))
END IF
DO i = 2, 4
IF (iatom <= jatom) THEN
dsblocks(i)%block(:, :) = dsblocks(i)%block(:, :) + sint(:, :, i)
ELSE
dsblocks(i)%block(:, :) = dsblocks(i)%block(:, :) - TRANSPOSE(sint(:, :, i))
END IF
END DO
! Calculate Pi = Pia * Pib (Eq. 11)
rcovab = rcova + rcovb
rrab = SQRT(dr/rcovab)
DO i = 1, nsa
pia(i) = 1._dp + kpolya(i)*rrab
END DO
DO i = 1, nsb
pib(i) = 1._dp + kpolyb(i)*rrab
END DO
IF (dr > 1.e-6_dp) THEN
drx = 0.5_dp/rrab/rcovab
ELSE
drx = 0.0_dp
END IF
dpia(1:nsa) = drx*kpolya(1:nsa)
dpib(1:nsb) = drx*kpolyb(1:nsb)
! diagonal block
diagblock = .FALSE.
IF (iatom == jatom .AND. dr < 0.001_dp) diagblock = .TRUE.
!
! Eq. 10
!
IF (diagblock) THEN
DO i = 1, natorb_a
na = naoa(i)
fblock(i, i) = fblock(i, i) + huckel(na, iatom)
END DO
ELSE
DO j = 1, natorb_b
nb = naob(j)
DO i = 1, natorb_a
na = naoa(i)
hij = 0.5_dp*(huckel(na, iatom) + huckel(nb, jatom))*pia(na)*pib(nb)
IF (iatom <= jatom) THEN
fblock(i, j) = fblock(i, j) + hij*sint(i, j, 1)*kijab(i, j, ikind, jkind)
ELSE
fblock(j, i) = fblock(j, i) + hij*sint(i, j, 1)*kijab(i, j, ikind, jkind)
END IF
END DO
END DO
END IF
f0 = 1.0_dp
IF (irow == iatom) f0 = -1.0_dp
! Derivative wrt coordination number
fhua = 0.0_dp
fhub = 0.0_dp
fhud = 0.0_dp
IF (diagblock) THEN
DO i = 1, natorb_a
la = laoa(i)
na = naoa(i)
fhud = fhud + pblock(i, i)*kcnlk(la, ikind)*hena(na)
END DO
ELSE
DO j = 1, natorb_b
lb = laob(j)
nb = naob(j)
DO i = 1, natorb_a
la = laoa(i)
na = naoa(i)
hij = 0.5_dp*pia(na)*pib(nb)
IF (iatom <= jatom) THEN
fhua = fhua + hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(i, j)*kcnlk(la, ikind)*hena(na)
fhub = fhub + hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(i, j)*kcnlk(lb, jkind)*henb(nb)
ELSE
fhua = fhua + hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(j, i)*kcnlk(la, ikind)*hena(na)
fhub = fhub + hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(j, i)*kcnlk(lb, jkind)*henb(nb)
END IF
END DO
END DO
IF (iatom /= jatom) THEN
fhua = 2.0_dp*fhua
fhub = 2.0_dp*fhub
END IF
END IF
! iatom
atom_a = atom_of_kind(iatom)
DO i = 1, dcnum(iatom)%neighbors
katom = dcnum(iatom)%nlist(i)
kkind = kind_of(katom)
atom_c = atom_of_kind(katom)
rik = dcnum(iatom)%rik(:, i)
drk = SQRT(SUM(rik(:)**2))
IF (drk > 1.e-3_dp) THEN
fdika(:) = fhua*dcnum(iatom)%dvals(i)*rik(:)/drk
force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a) - fdika(:)
force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c) + fdika(:)
fdikb(:) = fhud*dcnum(iatom)%dvals(i)*rik(:)/drk
force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a) - fdikb(:)
force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c) + fdikb(:)
END IF
END DO
! jatom
atom_b = atom_of_kind(jatom)
DO i = 1, dcnum(jatom)%neighbors
katom = dcnum(jatom)%nlist(i)
kkind = kind_of(katom)
atom_c = atom_of_kind(katom)
rik = dcnum(jatom)%rik(:, i)
drk = SQRT(SUM(rik(:)**2))
IF (drk > 1.e-3_dp) THEN
fdik(:) = fhub*dcnum(jatom)%dvals(i)*rik(:)/drk
force(jkind)%all_potential(:, atom_b) = force(jkind)%all_potential(:, atom_b) - fdik(:)
force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c) + fdik(:)
END IF
END DO
IF (diagblock) THEN
force_ab = 0._dp
ELSE
! force from R dendent Huckel element
n1 = SIZE(fblock, 1)
n2 = SIZE(fblock, 2)
ALLOCATE (dfblock(n1, n2))
dfblock = 0.0_dp
DO j = 1, natorb_b
lb = laob(j)
nb = naob(j)
DO i = 1, natorb_a
la = laoa(i)
na = naoa(i)
dhij = 0.5_dp*(huckel(na, iatom) + huckel(nb, jatom))*(dpia(na)*pib(nb) + pia(na)*dpib(nb))
IF (iatom <= jatom) THEN
dfblock(i, j) = dfblock(i, j) + dhij*sint(i, j, 1)*kijab(i, j, ikind, jkind)
ELSE
dfblock(j, i) = dfblock(j, i) + dhij*sint(i, j, 1)*kijab(i, j, ikind, jkind)
END IF
END DO
END DO
dfp = f0*SUM(dfblock(:, :)*pblock(:, :))
DO ir = 1, 3
foab = 2.0_dp*dfp*rij(ir)/dr
! force from overlap matrix contribution to H
DO j = 1, natorb_b
lb = laob(j)
nb = naob(j)
DO i = 1, natorb_a
la = laoa(i)
na = naoa(i)
hij = 0.5_dp*(huckel(na, iatom) + huckel(nb, jatom))*pia(na)*pib(nb)
IF (iatom <= jatom) THEN
foab = foab + 2.0_dp*hij*sint(i, j, ir + 1)*pblock(i, j)*kijab(i, j, ikind, jkind)
ELSE
foab = foab - 2.0_dp*hij*sint(i, j, ir + 1)*pblock(j, i)*kijab(i, j, ikind, jkind)
END IF
END DO
END DO
force_ab(ir) = foab
END DO
DEALLOCATE (dfblock)
END IF
atom_a = atom_of_kind(iatom)
atom_b = atom_of_kind(jatom)
IF (irow == iatom) force_ab = -force_ab
force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a) - force_ab(:)
force(jkind)%all_potential(:, atom_b) = force(jkind)%all_potential(:, atom_b) + force_ab(:)
DEALLOCATE (oint, owork, sint)
END DO
CALL neighbor_list_iterator_release(nl_iterator)
DO i = 1, SIZE(matrix_h, 1)
DO img = 1, nimg
CALL dbcsr_finalize(matrix_h(i, img)%matrix)
CALL dbcsr_finalize(matrix_s(i, img)%matrix)
END DO
ENDDO
CALL dbcsr_deallocate_matrix_set(matrix_s)
CALL dbcsr_deallocate_matrix_set(matrix_h)
! deallocate coordination numbers
DEALLOCATE (cnumbers)
DO iatom = 1, natom
DEALLOCATE (dcnum(iatom)%nlist, dcnum(iatom)%dvals, dcnum(iatom)%rik)
END DO
DEALLOCATE (dcnum)
! deallocate Huckel parameters
DEALLOCATE (huckel)
! deallocate KAB parameters
DEALLOCATE (kijab)
DEALLOCATE (basis_set_list)
DEALLOCATE (kind_of)
DEALLOCATE (atom_of_kind)
CALL timestop(handle)
END SUBROUTINE xtb_hab_force
! **************************************************************************************************
!> \brief ...
!> \param qs_env ...

4
tests/QS/regtest-corr_dipm/TEST_FILES
View file

@ -2,6 +2,6 @@
# the second field tells which option from cp2k/tests/TEST_TYPES must be grepped to verify the results
# 3rd field ---> tolerance
# 4th field ---> reference result
run-corr_dipm-RKS.inp 89 1e-04 0.0002032692
run-corr_dipm-UKS.inp 89 1e-04 0.0002032739
run-corr_dipm-RKS.inp 89 1e-04 0.0002025426
run-corr_dipm-UKS.inp 89 1e-04 0.0002023505
#EOF

2
tests/QS/regtest-debug-1/TEST_FILES
View file

@ -4,7 +4,7 @@
# 1 compares the last total energy in the file
# for details see cp2k/tools/do_regtest
h2o_dipole.inp 86 1e-05 0.908927636669E+00
h2o_polar.inp 87 1e-05 0.164538039001E+02
h2o_polar.inp 87 1e-05 0.166347691437E+02
h2o_pdip.inp 86 1e-05 0.961018561809E+00
h2o_periodic.inp 87 1e-05 0.139741440657E+02
h2o_gga.inp 87 1e-05 0.165143521103E+02

8
tests/QS/regtest-debug-1/h2o_gga.inp
View file

@ -17,6 +17,10 @@
&END QS
&EFIELD
&END
&MGRID
CUTOFF 280
REL_CUTOFF 60
&END
&SCF
SCF_GUESS ATOMIC
&OT
@ -25,10 +29,10 @@
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-4
EPS_SCF 1.0E-6
&END
MAX_SCF 10
EPS_SCF 1.0E-4
EPS_SCF 1.0E-6
&END SCF
&XC
&XC_FUNCTIONAL PBE

2
tests/QS/regtest-debug-1/h2o_polar.inp
View file

@ -43,7 +43,7 @@
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
ABC [angstrom] 5.0 5.0 5.0
PERIODIC NONE
&END
&COORD

6
tests/QS/regtest-debug-2/TEST_FILES
View file

@ -3,8 +3,8 @@
# e.g. 0 means do not compare anything, running is enough
# 1 compares the last total energy in the file
# for details see cp2k/tools/do_regtest
h2o_lri.inp 87 2e-05 0.219139762139E+02
h2o_pade_fd.inp 87 1e-05 0.166348378051E+02
h2o_lri.inp 87 1e-05 0.222165614960E+02
h2o_pade_fd.inp 87 1e-05 0.168333363169E+02
h2o_hfx.inp 87 1e-05 0.155040875037E+02
h2o_hfx_admm.inp 87 1e-05 0.151709407272E+02
h2o_hfx_admm.inp 87 1e-05 0.153251090463E+02
#EOF

6
tests/QS/regtest-debug-2/h2o_hfx_admm.inp
View file

@ -33,10 +33,10 @@
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
EPS_SCF 1.0E-6
&END
MAX_SCF 100
EPS_SCF 1.0E-7
EPS_SCF 1.0E-6
&END SCF
&XC
&XC_FUNCTIONAL NONE
@ -56,7 +56,7 @@
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
ABC [angstrom] 5.0 5.0 5.0
PERIODIC NONE
&END
&COORD

10
tests/QS/regtest-debug-2/h2o_lri.inp
View file

@ -27,11 +27,15 @@
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-4
EPS_SCF 1.0E-6
&END
MAX_SCF 10
EPS_SCF 1.0E-4
EPS_SCF 1.0E-6
&END SCF
&MGRID
CUTOFF 240
REL_CUTOFF 40
&END
&XC
&XC_FUNCTIONAL PBE
&END XC_FUNCTIONAL
@ -45,7 +49,7 @@
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 5.0 5.0 5.0
ABC [angstrom] 4.5 4.5 4.5
PERIODIC NONE
&END
&COORD

8
tests/QS/regtest-debug-2/h2o_pade_fd.inp
View file

@ -14,7 +14,7 @@
LSD
&QS
METHOD GPW
EPS_DEFAULT 1.e-14
EPS_DEFAULT 1.e-10
&END QS
&EFIELD
&END
@ -26,10 +26,10 @@
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-5
EPS_SCF 1.0E-6
&END
MAX_SCF 10
EPS_SCF 1.0E-5
EPS_SCF 1.0E-6
&END SCF
&XC
&XC_FUNCTIONAL PADE
@ -45,7 +45,7 @@
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 5.0 5.0 5.0
ABC [angstrom] 4.5 4.5 4.5
PERIODIC NONE
&END
&COORD

84
tests/QS/regtest-debug-2/h2o_pbe_fd.inp Normal file
View file

@ -0,0 +1,84 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-09
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
&QS
METHOD GPW
EPS_DEFAULT 1.e-14
&END QS
&EFIELD
&END
&SCF
SCF_GUESS ATOMIC
&OT
PRECONDITIONER FULL_ALL
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
&END
MAX_SCF 10
EPS_SCF 1.0E-7
&END SCF
&XC
&XC_FUNCTIONAL PBE
&END XC_FUNCTIONAL
2ND_DERIV_ANALYTICAL F
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
RUN_TYPE DEBUG
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .FALSE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.002
EPS_NO_ERROR_CHECK 1.e-4
&END

89
tests/QS/regtest-debug-2/h2o_tpss_fd.inp Normal file
View file

@ -0,0 +1,89 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-09
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
LSD
&QS
METHOD GPW
EPS_DEFAULT 1.e-14
&END QS
&EFIELD
&END
&SCF
SCF_GUESS ATOMIC
&OT
PRECONDITIONER FULL_SINGLE_INVERSE
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
&END
MAX_SCF 10
EPS_SCF 1.0E-7
&END SCF
&XC
&XC_FUNCTIONAL
&MGGA_X_TPSS
&END MGGA_X_TPSS
&MGGA_C_TPSS
&END MGGA_C_TPSS
&END XC_FUNCTIONAL
2ND_DERIV_ANALYTICAL F
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
RUN_TYPE DEBUG
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .FALSE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.002
EPS_NO_ERROR_CHECK 1.e-4
&END

18
tests/QS/regtest-debug-3/TEST_FILES
View file

@ -3,6 +3,20 @@
# e.g. 0 means do not compare anything, running is enough
# 1 compares the last total energy in the file
# for details see cp2k/tools/do_regtest
h2o_pbe0.inp 87 1e-05 0.154942790950E+02
h2o_pbe0_admm.inp 87 1e-05 0.159299388421E+02
h2o_pbe0.inp 60 1e-05 0.411901963703
h2o_pbe0_admm.inp 60 1e-05 0.426369189904
#
h2o_HSE06.inp 60 1e-05 0.436263865396
h2o_HSE06_admm.inp 60 1e-05 0.381688458912
#h2o_B88_mixcl.inp functional B88_LR 60 1e-05 0.000000000000E+00
#h2o_B88_mixcl_admm.inp functional B88_LR 60 1e-05 0.000000000000E+00
h2o_pbe0TC.inp 60 1e-05 0.430192264863
h2o_pbe0TC_admm.inp 60 1e-05 0.426587857103
#h2o_B88_mixcl_TC_admm.inp functional B88_LR 60 1e-05 0.000000000000E+00
#h2o_B88_mixcl_TC.inp functional B88_LR 60 1e-05 0.000000000000E+00
#h2o_pbe0TC_LRC.inp functional LRC
#h2o_pbe0TC_LRC_admm.inp functional LRC
#h2o_mgga_VV3_mixcl_admm.inp functional mgga
#h2o_mgga_VV3_mixcl.inp functional mgga
#EOF

115
tests/QS/regtest-debug-3/h2o_B88_mixcl.inp Normal file
View file

@ -0,0 +1,115 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-14
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
BASIS_SET_FILE_NAME BASIS_SET
&QS
METHOD GPW
EPS_DEFAULT 1.e-14
&END QS
&EFIELD
&END
&SCF
SCF_GUESS ATOMIC
&OT ON
PRECONDITIONER FULL_SINGLE_INVERSE
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-8
&END
MAX_SCF 100
EPS_SCF 1.0E-8
&END SCF
&XC
&XC_FUNCTIONAL
&BECKE88
SCALE_X 0.95238
&END
&BECKE88_LR
OMEGA 0.33
SCALE_X -0.94979
&END
&LYP
SCALE_C 1.0
&END
&XALPHA
SCALE_X -0.13590
&END
&END XC_FUNCTIONAL
&HF
&SCREENING
EPS_SCHWARZ 1.0E-12
&END
&MEMORY
MAX_MEMORY 100
&END
&INTERACTION_POTENTIAL
POTENTIAL_TYPE MIX_CL
OMEGA 0.33
SCALE_LONGRANGE 0.94979
SCALE_COULOMB 0.18352
&END
&END
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&POISSON
PERIODIC NONE
POISSON_SOLVER MT
&END POISSON
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
RUN_TYPE DEBUG
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .TRUE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.000005
EPS_NO_ERROR_CHECK 5.e-5
&END

114
tests/QS/regtest-debug-3/h2o_B88_mixcl_TC.inp Normal file
View file

@ -0,0 +1,114 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-10
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
BASIS_SET_FILE_NAME BASIS_SET
&QS
METHOD GPW
EPS_DEFAULT 1.e-10
&END QS
&EFIELD
&END
&SCF
SCF_GUESS RESTART
&OT OFF
PRECONDITIONER FULL_SINGLE_INVERSE
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
&END
MAX_SCF 100
EPS_SCF 1.0E-7
&END SCF
&XC
&XC_FUNCTIONAL
&BECKE88
SCALE_X 0.95238
&END
&BECKE88_LR
OMEGA 0.33
SCALE_X -0.94979
&END
&LYP
SCALE_C 1.0
&END
&XALPHA
SCALE_X -0.13590
&END
&END XC_FUNCTIONAL
&HF
&SCREENING
EPS_SCHWARZ 1.0E-7
&END
&MEMORY
MAX_MEMORY 100
&END
&INTERACTION_POTENTIAL
POTENTIAL_TYPE MIX_CL_TRUNC
OMEGA 0.33
SCALE_LONGRANGE 0.94979
SCALE_COULOMB 0.18352
! should be cell L/2 but large enough for the erf to decay
CUTOFF_RADIUS 2.5
T_C_G_DATA t_c_g.dat
&END
&END
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
RUN_TYPE DEBUG
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .TRUE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.0002
EPS_NO_ERROR_CHECK 5.e-5
&END

123
tests/QS/regtest-debug-3/h2o_B88_mixcl_TC_admm.inp Normal file
View file

@ -0,0 +1,123 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-10
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
BASIS_SET_FILE_NAME BASIS_SET
BASIS_SET_FILE_NAME BASIS_ADMM
&QS
METHOD GPW
EPS_DEFAULT 1.e-10
&END QS
&AUXILIARY_DENSITY_MATRIX_METHOD
ADMM_PURIFICATION_METHOD NONE
EXCH_CORRECTION_FUNC BECKE88X
EXCH_SCALING_MODEL NONE
METHOD BASIS_PROJECTION
&END
&EFIELD
&END
&SCF
SCF_GUESS RESTART
&OT OFF
PRECONDITIONER FULL_SINGLE_INVERSE
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
&END
MAX_SCF 100
EPS_SCF 1.0E-7
&END SCF
&XC
&XC_FUNCTIONAL
&BECKE88
SCALE_X 0.95238
&END
&BECKE88_LR
OMEGA 0.33
SCALE_X -0.94979
&END
&LYP
SCALE_C 1.0
&END
&XALPHA
SCALE_X -0.13590
&END
&END XC_FUNCTIONAL
&HF
&SCREENING
EPS_SCHWARZ 1.0E-7
&END
&MEMORY
MAX_MEMORY 100
&END
&INTERACTION_POTENTIAL
POTENTIAL_TYPE MIX_CL_TRUNC
OMEGA 0.33
SCALE_LONGRANGE 0.94979
SCALE_COULOMB 0.18352
! should be cell L/2 but large enough for the erf to decay
CUTOFF_RADIUS 2.5
T_C_G_DATA t_c_g.dat
&END
&END
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
BASIS_SET AUX_FIT FIT3
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
BASIS_SET AUX_FIT FIT3
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
RUN_TYPE DEBUG
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .TRUE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.0002
EPS_NO_ERROR_CHECK 5.e-5
&END

120
tests/QS/regtest-debug-3/h2o_B88_mixcl_admm.inp Normal file
View file

@ -0,0 +1,120 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-10
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
BASIS_SET_FILE_NAME BASIS_SET
BASIS_SET_FILE_NAME BASIS_ADMM
&QS
METHOD GPW
EPS_DEFAULT 1.e-10
&END QS
&AUXILIARY_DENSITY_MATRIX_METHOD
ADMM_PURIFICATION_METHOD NONE
EXCH_CORRECTION_FUNC BECKE88X
EXCH_SCALING_MODEL NONE
METHOD BASIS_PROJECTION
&END
&EFIELD
&END
&SCF
SCF_GUESS RESTART
&OT OFF
PRECONDITIONER FULL_SINGLE_INVERSE
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
&END
MAX_SCF 100
EPS_SCF 1.0E-7
&END SCF
&XC
&XC_FUNCTIONAL
&BECKE88
SCALE_X 0.95238
&END
&BECKE88_LR
OMEGA 0.33
SCALE_X -0.94979
&END
&LYP
SCALE_C 1.0
&END
&XALPHA
SCALE_X -0.13590
&END
&END XC_FUNCTIONAL
&HF
&SCREENING
EPS_SCHWARZ 1.0E-10
&END
&MEMORY
MAX_MEMORY 100
&END
&INTERACTION_POTENTIAL
POTENTIAL_TYPE MIX_CL
OMEGA 0.33
SCALE_LONGRANGE 0.94979
SCALE_COULOMB 0.18352
&END
&END
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
BASIS_SET AUX_FIT FIT3
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
BASIS_SET AUX_FIT FIT3
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
RUN_TYPE DEBUG
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .TRUE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.0002
EPS_NO_ERROR_CHECK 5.e-5
&END

105
tests/QS/regtest-debug-3/h2o_HSE06.inp Normal file
View file

@ -0,0 +1,105 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-10
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
BASIS_SET_FILE_NAME BASIS_SET
&QS
METHOD GPW
EPS_DEFAULT 1.e-14
&END QS
&EFIELD
&END
&SCF
SCF_GUESS ATOMIC
&OT OFF
PRECONDITIONER FULL_SINGLE_INVERSE
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
&END
MAX_SCF 100
EPS_SCF 1.0E-7
&END SCF
&MGRID
CUTOFF 200
&END MGRID
&XC
&XC_FUNCTIONAL
&HYB_GGA_XC_HSE06
&END HYB_GGA_XC_HSE06
&END XC_FUNCTIONAL
&HF
&SCREENING
EPS_SCHWARZ 1.0E-12
SCREEN_ON_INITIAL_P FALSE
&END
&MEMORY
MAX_MEMORY 900
EPS_STORAGE_SCALING 0.1
&END
&INTERACTION_POTENTIAL
POTENTIAL_TYPE SHORTRANGE
OMEGA 0.11
&END
FRACTION 0.25
&END
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 5.0 5.0 5.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
### RUN_TYPE DEBUG
RUN_TYPE ENERGY_FORCE
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .TRUE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.0002
EPS_NO_ERROR_CHECK 5.e-5
&END

114
tests/QS/regtest-debug-3/h2o_HSE06_admm.inp Normal file
View file

@ -0,0 +1,114 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-10
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
BASIS_SET_FILE_NAME BASIS_SET
BASIS_SET_FILE_NAME BASIS_ADMM
&QS
METHOD GPW
EPS_DEFAULT 1.e-10
&END QS
&AUXILIARY_DENSITY_MATRIX_METHOD
ADMM_PURIFICATION_METHOD NONE
EXCH_CORRECTION_FUNC BECKE88X
EXCH_SCALING_MODEL NONE
METHOD BASIS_PROJECTION
&END
&EFIELD
&END
&SCF
SCF_GUESS ATOMIC
&OT OFF
PRECONDITIONER FULL_SINGLE_INVERSE
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
&END
MAX_SCF 100
EPS_SCF 1.0E-7
&END SCF
&MGRID
CUTOFF 200
&END MGRID
&XC
&XC_FUNCTIONAL
&HYB_GGA_XC_HSE06
&END HYB_GGA_XC_HSE06
&END XC_FUNCTIONAL
&HF
&SCREENING
EPS_SCHWARZ 1.0E-12
SCREEN_ON_INITIAL_P FALSE
&END
&MEMORY
MAX_MEMORY 900
EPS_STORAGE_SCALING 0.1
&END
&INTERACTION_POTENTIAL
POTENTIAL_TYPE SHORTRANGE
OMEGA 0.11
&END
FRACTION 0.25
&END
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 5.0 5.0 5.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
BASIS_SET AUX_FIT FIT3
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
BASIS_SET AUX_FIT FIT3
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
### RUN_TYPE DEBUG
RUN_TYPE ENERGY_FORCE
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .TRUE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.0002
EPS_NO_ERROR_CHECK 5.e-5
&END

112
tests/QS/regtest-debug-3/h2o_mgga_VV3_mixcl.inp Normal file
View file

@ -0,0 +1,112 @@
&FORCE_EVAL
METHOD Quickstep
&PROPERTIES
&LINRES
PRECONDITIONER FULL_ALL
EPS 1.e-10
&POLAR
DO_RAMAN T
PERIODIC_DIPOLE_OPERATOR F
&END
&END
&END
&DFT
BASIS_SET_FILE_NAME BASIS_SET
&QS
METHOD GPW
EPS_DEFAULT 1.e-10
&END QS
&EFIELD
&END
&SCF
SCF_GUESS RESTART
&OT OFF
PRECONDITIONER FULL_SINGLE_INVERSE
MINIMIZER DIIS
&END
&OUTER_SCF
MAX_SCF 10
EPS_SCF 1.0E-7
&END
MAX_SCF 100
EPS_SCF 1.0E-7
&END SCF
&XC
&XC_FUNCTIONAL
&HYB_MGGA_XC_WB97M_V
&END HYB_MGGA_XC_WB97M_V
&END XC_FUNCTIONAL
2ND_DERIV_ANALYTICAL F
&HF
FRACTION 1.000
&SCREENING
EPS_SCHWARZ 1.0E-6
&END
&INTERACTION_POTENTIAL
POTENTIAL_TYPE MIX_CL
SCALE_COULOMB 0.15
SCALE_LONGRANGE 0.85
OMEGA 0.30
&END
&MEMORY
MAX_MEMORY 10
&END
&END
&vdW_POTENTIAL
DISPERSION_FUNCTIONAL NON_LOCAL
&NON_LOCAL
TYPE RVV10
PARAMETERS 6.0 0.01
VERBOSE_OUTPUT
KERNEL_FILE_NAME rVV10_kernel_table.dat
CUTOFF 30
&END NON_LOCAL
&END vdW_POTENTIAL
&END XC
&PRINT
&MOMENTS ON
PERIODIC .FALSE.
REFERENCE COM
&END
&END
&END DFT
&SUBSYS
&CELL
ABC [angstrom] 6.0 6.0 6.0
PERIODIC NONE
&END
&COORD
O 0.000000 0.000000 -0.065587
H 0.000000 -0.757136 0.520545
H 0.000000 0.757136 0.520545
&END COORD
&TOPOLOGY
&CENTER_COORDINATES
&END
&END
&KIND H
BASIS_SET DZV-GTH-PADE
POTENTIAL GTH-PADE-q1
&END KIND
&KIND O
BASIS_SET DZVP-GTH-PADE
POTENTIAL GTH-PADE-q6
&END KIND
&END SUBSYS
&END FORCE_EVAL
&GLOBAL
PRINT_LEVEL LOW
PROJECT dipole
RUN_TYPE DEBUG
&END GLOBAL
&DEBUG
DEBUG_FORCES .FALSE.
DEBUG_STRESS_TENSOR .FALSE.
DEBUG_DIPOLE .TRUE.
DEBUG_POLARIZABILITY .TRUE.
DE 0.0002
EPS_NO_ERROR_CHECK 5.e-5
&END

Some files were not shown because too many files have changed in this diff Show more