47 USE dbcsr_api,
ONLY: &
48 dbcsr_add, dbcsr_copy, dbcsr_create, dbcsr_distribution_type, dbcsr_multiply, &
49 dbcsr_p_type, dbcsr_release, dbcsr_scale, dbcsr_set, dbcsr_type, dbcsr_type_no_symmetry
105 qs_environment_type,&
153 #include "./base/base_uses.f90"
161 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'response_solver'
181 TYPE(qs_environment_type),
POINTER :: qs_env
182 TYPE(energy_correction_type),
POINTER :: ec_env
184 CHARACTER(LEN=*),
PARAMETER :: routinen =
'response_calculation'
186 INTEGER :: handle, homo, ispin, nao, nao_aux, nmo, &
187 nocc, nspins, solver_method, unit_nr
188 LOGICAL :: should_stop
189 REAL(kind=
dp) :: focc
190 TYPE(admm_type),
POINTER :: admm_env
191 TYPE(cp_blacs_env_type),
POINTER :: blacs_env
192 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
193 TYPE(cp_fm_type) :: sv
194 TYPE(cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: cpmos, mo_occ
195 TYPE(cp_fm_type),
POINTER :: mo_coeff
196 TYPE(cp_logger_type),
POINTER :: logger
197 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_s, matrix_s_aux, rho_ao
198 TYPE(dft_control_type),
POINTER :: dft_control
199 TYPE(linres_control_type),
POINTER :: linres_control
200 TYPE(mo_set_type),
DIMENSION(:),
POINTER :: mos
201 TYPE(mp_para_env_type),
POINTER :: para_env
202 TYPE(neighbor_list_set_p_type),
DIMENSION(:), &
204 TYPE(qs_energy_type),
POINTER :: energy
205 TYPE(qs_p_env_type),
POINTER :: p_env
206 TYPE(qs_rho_type),
POINTER :: rho
207 TYPE(section_vals_type),
POINTER :: input, solver_section
209 CALL timeset(routinen, handle)
211 NULLIFY (admm_env, dft_control, energy, logger, matrix_s, matrix_s_aux, mo_coeff, mos, para_env, &
212 rho_ao, sab_orb, solver_section)
216 IF (logger%para_env%is_source())
THEN
223 dft_control=dft_control, &
228 nspins = dft_control%nspins
231 NULLIFY (linres_control)
232 ALLOCATE (linres_control)
233 linres_control%do_kernel = .true.
234 linres_control%lr_triplet = .false.
235 linres_control%converged = .false.
236 linres_control%energy_gap = 0.02_dp
244 CALL section_vals_val_get(solver_section,
"PRECONDITIONER", i_val=linres_control%preconditioner_type)
247 CALL set_qs_env(qs_env, linres_control=linres_control)
250 CALL response_solver_write_input(solver_section, linres_control, unit_nr)
258 ALLOCATE (ec_env%matrix_wz(ispin)%matrix)
259 ALLOCATE (ec_env%matrix_z(ispin)%matrix)
260 CALL dbcsr_create(ec_env%matrix_wz(ispin)%matrix, name=
"Wz MATRIX", &
261 template=matrix_s(1)%matrix)
262 CALL dbcsr_create(ec_env%matrix_z(ispin)%matrix, name=
"Z MATRIX", &
263 template=matrix_s(1)%matrix)
266 CALL dbcsr_set(ec_env%matrix_wz(ispin)%matrix, 0.0_dp)
267 CALL dbcsr_set(ec_env%matrix_z(ispin)%matrix, 0.0_dp)
274 IF (dft_control%qs_control%do_ls_scf)
THEN
286 nmo=nmo, nao=nao, homo=homo)
296 CALL cp_fm_release(sv)
305 blacs_env=blacs_env, para_env=para_env)
311 IF (
ASSOCIATED(ec_env%p_env))
THEN
313 DEALLOCATE (ec_env%p_env)
314 NULLIFY (ec_env%p_env)
316 ALLOCATE (ec_env%p_env)
317 CALL p_env_create(ec_env%p_env, qs_env, orthogonal_orbitals=.true., &
318 linres_control=linres_control)
322 energy%total = ec_env%etotal
324 p_env => ec_env%p_env
329 ALLOCATE (p_env%p1(ispin)%matrix, p_env%w1(ispin)%matrix)
330 CALL dbcsr_create(matrix=p_env%p1(ispin)%matrix, template=matrix_s(1)%matrix)
331 CALL dbcsr_create(matrix=p_env%w1(ispin)%matrix, template=matrix_s(1)%matrix)
335 IF (dft_control%do_admm)
THEN
336 CALL get_admm_env(qs_env%admm_env, matrix_s_aux_fit=matrix_s_aux)
339 ALLOCATE (p_env%p1_admm(ispin)%matrix)
340 CALL dbcsr_create(p_env%p1_admm(ispin)%matrix, &
341 template=matrix_s_aux(1)%matrix)
342 CALL dbcsr_copy(p_env%p1_admm(ispin)%matrix, matrix_s_aux(1)%matrix)
343 CALL dbcsr_set(p_env%p1_admm(ispin)%matrix, 0.0_dp)
348 SELECT CASE (solver_method)
355 ALLOCATE (cpmos(nspins), mo_occ(nspins))
357 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, homo=nocc)
360 template_fmstruct=mo_coeff%matrix_struct)
364 CALL cp_fm_to_fm(mo_coeff, mo_occ(ispin), nocc)
369 IF (nspins == 1) focc = 4.0_dp
371 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, homo=nocc)
373 cpmos(ispin), nocc, &
374 alpha=focc, beta=0.0_dp)
376 CALL cp_fm_release(mo_occ)
383 CALL dbcsr_copy(ec_env%matrix_z(ispin)%matrix, p_env%p1(ispin)%matrix)
384 CALL dbcsr_copy(ec_env%matrix_wz(ispin)%matrix, p_env%w1(ispin)%matrix)
386 CALL cp_fm_release(cpmos)
393 matrix_hz=ec_env%matrix_hz, &
394 matrix_pz=ec_env%matrix_z, &
395 matrix_wz=ec_env%matrix_wz, &
397 should_stop=should_stop)
399 IF (dft_control%do_admm)
THEN
401 cpassert(
ASSOCIATED(admm_env%work_orb_orb))
402 cpassert(
ASSOCIATED(admm_env%work_aux_orb))
403 cpassert(
ASSOCIATED(admm_env%work_aux_aux))
404 nao = admm_env%nao_orb
405 nao_aux = admm_env%nao_aux_fit
408 CALL parallel_gemm(
'N',
'N', nao_aux, nao, nao, &
409 1.0_dp, admm_env%A, admm_env%work_orb_orb, 0.0_dp, &
410 admm_env%work_aux_orb)
411 CALL parallel_gemm(
'N',
'T', nao_aux, nao_aux, nao, &
412 1.0_dp, admm_env%work_aux_orb, admm_env%A, 0.0_dp, &
413 admm_env%work_aux_aux)
415 keep_sparsity=.true.)
420 cpabort(
"Unknown solver for response equation requested")
423 IF (dft_control%do_admm)
THEN
426 ALLOCATE (ec_env%z_admm(ispin)%matrix)
427 CALL dbcsr_create(matrix=ec_env%z_admm(ispin)%matrix, template=matrix_s_aux(1)%matrix)
429 CALL dbcsr_copy(ec_env%z_admm(ispin)%matrix, p_env%p1_admm(ispin)%matrix)
434 IF (dft_control%qs_control%do_ls_scf)
THEN
438 IF (
ASSOCIATED(qs_env%mos))
THEN
439 DO ispin = 1,
SIZE(qs_env%mos)
442 DEALLOCATE (qs_env%mos)
446 CALL timestop(handle)
459 SUBROUTINE response_solver_write_input(input, linres_control, unit_nr)
460 TYPE(section_vals_type),
POINTER :: input
461 TYPE(linres_control_type),
POINTER :: linres_control
462 INTEGER,
INTENT(IN) :: unit_nr
464 CHARACTER(len=*),
PARAMETER :: routinen =
'response_solver_write_input'
466 INTEGER :: handle, max_iter_lanczos, s_sqrt_method, &
467 s_sqrt_order, solver_method
468 REAL(kind=
dp) :: eps_lanczos
470 CALL timeset(routinen, handle)
472 IF (unit_nr > 0)
THEN
475 WRITE (unit_nr,
'(/,T2,A)') &
476 repeat(
"-", 30)//
" Linear Response Solver "//repeat(
"-", 25)
481 SELECT CASE (solver_method)
483 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Solver: ",
"AO-based CG-solver"
485 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Solver: ",
"MO-based CG-solver"
488 WRITE (unit_nr,
'(T2,A,T61,E20.3)')
"eps:", linres_control%eps
489 WRITE (unit_nr,
'(T2,A,T61,E20.3)')
"eps_filter:", linres_control%eps_filter
490 WRITE (unit_nr,
'(T2,A,T61,I20)')
"Max iter:", linres_control%max_iter
492 SELECT CASE (linres_control%preconditioner_type)
494 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Preconditioner: ",
"FULL_ALL"
496 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Preconditioner: ",
"FULL_SINGLE_INVERSE"
498 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Preconditioner: ",
"FULL_SINGLE"
500 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Preconditioner: ",
"FULL_KINETIC"
502 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Preconditioner: ",
"FULL_S_INVERSE"
504 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Preconditioner: ",
"MULTI_LEVEL"
506 WRITE (unit_nr,
'(T2,A,T61,A20)')
"Preconditioner: ",
"NONE"
509 SELECT CASE (solver_method)
519 SELECT CASE (s_sqrt_method)
521 WRITE (unit_nr,
'(T2,A,T61,A20)')
"S sqrt method:",
"NEWTONSCHULZ"
523 WRITE (unit_nr,
'(T2,A,T61,A20)')
"S sqrt method:",
"PROOT"
525 cpabort(
"Unknown sqrt method.")
527 WRITE (unit_nr,
'(T2,A,T61,I20)')
"S sqrt order:", s_sqrt_order
532 WRITE (unit_nr,
'(T2,A)') repeat(
"-", 79)
537 CALL timestop(handle)
539 END SUBROUTINE response_solver_write_input
551 TYPE(qs_environment_type),
POINTER :: qs_env
552 TYPE(qs_p_env_type) :: p_env
553 TYPE(cp_fm_type),
DIMENSION(:),
INTENT(INOUT) :: cpmos
554 INTEGER,
INTENT(IN) :: iounit
556 CHARACTER(LEN=*),
PARAMETER :: routinen =
'response_equation_new'
558 INTEGER :: handle, ispin, nao, nao_aux, nocc, nspins
559 LOGICAL :: should_stop
560 TYPE(admm_type),
POINTER :: admm_env
561 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
562 TYPE(cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: psi0, psi1
563 TYPE(cp_fm_type),
POINTER :: mo_coeff
564 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_ks, matrix_s
565 TYPE(dft_control_type),
POINTER :: dft_control
566 TYPE(mo_set_type),
DIMENSION(:),
POINTER :: mos
568 CALL timeset(routinen, handle)
570 NULLIFY (dft_control, matrix_ks, mo_coeff, mos)
572 CALL get_qs_env(qs_env, dft_control=dft_control, matrix_ks=matrix_ks, &
573 matrix_s=matrix_s, mos=mos)
574 nspins = dft_control%nspins
579 ALLOCATE (psi0(nspins), psi1(nspins))
581 CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, homo=nocc)
584 template_fmstruct=mo_coeff%matrix_struct)
586 CALL cp_fm_to_fm(mo_coeff, psi0(ispin), nocc)
592 should_stop = .false.
594 CALL linres_solver(p_env, qs_env, psi1, cpmos, psi0, iounit, should_stop)
598 CALL dbcsr_copy(p_env%p1(ispin)%matrix, matrix_s(1)%matrix)
602 CALL dbcsr_scale(p_env%p1(ispin)%matrix, 0.5_dp)
605 IF (dft_control%do_admm)
THEN
607 cpassert(
ASSOCIATED(admm_env%work_orb_orb))
608 cpassert(
ASSOCIATED(admm_env%work_aux_orb))
609 cpassert(
ASSOCIATED(admm_env%work_aux_aux))
610 nao = admm_env%nao_orb
611 nao_aux = admm_env%nao_aux_fit
614 CALL parallel_gemm(
'N',
'N', nao_aux, nao, nao, &
615 1.0_dp, admm_env%A, admm_env%work_orb_orb, 0.0_dp, &
616 admm_env%work_aux_orb)
617 CALL parallel_gemm(
'N',
'T', nao_aux, nao_aux, nao, &
618 1.0_dp, admm_env%work_aux_orb, admm_env%A, 0.0_dp, &
619 admm_env%work_aux_aux)
621 keep_sparsity=.true.)
628 p_env%w1(ispin)%matrix)
631 CALL cp_fm_release(cpmos(ispin))
633 CALL cp_fm_release(psi1)
634 CALL cp_fm_release(psi0)
636 CALL timestop(handle)
651 TYPE(qs_environment_type),
POINTER :: qs_env
652 TYPE(qs_p_env_type) :: p_env
653 TYPE(cp_fm_type),
DIMENSION(:),
POINTER :: cpmos
654 INTEGER,
INTENT(IN) :: iounit
655 TYPE(section_vals_type),
OPTIONAL,
POINTER :: lr_section
657 CHARACTER(LEN=*),
PARAMETER :: routinen =
'response_equation'
659 INTEGER :: handle, ispin, nao, nao_aux, nocc, nspins
660 LOGICAL :: should_stop
661 TYPE(admm_type),
POINTER :: admm_env
662 TYPE(cp_fm_struct_type),
POINTER :: fm_struct
663 TYPE(cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: psi0, psi1
664 TYPE(cp_fm_type),
POINTER :: mo_coeff
665 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_ks, matrix_s, matrix_s_aux
666 TYPE(dft_control_type),
POINTER :: dft_control
667 TYPE(linres_control_type),
POINTER :: linres_control
668 TYPE(mo_set_type),
DIMENSION(:),
POINTER :: mos
669 TYPE(neighbor_list_set_p_type),
DIMENSION(:), &
672 CALL timeset(routinen, handle)
675 NULLIFY (linres_control)
676 ALLOCATE (linres_control)
677 linres_control%do_kernel = .true.
678 linres_control%lr_triplet = .false.
679 IF (
PRESENT(lr_section))
THEN
685 CALL section_vals_val_get(lr_section,
"PRECONDITIONER", i_val=linres_control%preconditioner_type)
688 linres_control%linres_restart = .false.
689 linres_control%max_iter = 100
690 linres_control%eps = 1.0e-10_dp
691 linres_control%eps_filter = 1.0e-15_dp
692 linres_control%restart_every = 50
694 linres_control%energy_gap = 0.02_dp
698 CALL p_env_create(p_env, qs_env, orthogonal_orbitals=.true., &
699 linres_control=linres_control)
700 CALL set_qs_env(qs_env, linres_control=linres_control)
702 p_env%new_preconditioner = .true.
704 CALL get_qs_env(qs_env, dft_control=dft_control, mos=mos)
706 nspins = dft_control%nspins
711 ALLOCATE (psi0(nspins), psi1(nspins))
713 CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, homo=nocc)
716 template_fmstruct=mo_coeff%matrix_struct)
718 CALL cp_fm_to_fm(mo_coeff, psi0(ispin), nocc)
724 should_stop = .false.
726 CALL get_qs_env(qs_env, matrix_s=matrix_s, sab_orb=sab_orb)
730 ALLOCATE (p_env%p1(ispin)%matrix, p_env%w1(ispin)%matrix)
731 CALL dbcsr_create(matrix=p_env%p1(ispin)%matrix, template=matrix_s(1)%matrix)
732 CALL dbcsr_create(matrix=p_env%w1(ispin)%matrix, template=matrix_s(1)%matrix)
736 IF (dft_control%do_admm)
THEN
737 CALL get_admm_env(qs_env%admm_env, matrix_s_aux_fit=matrix_s_aux)
740 ALLOCATE (p_env%p1_admm(ispin)%matrix)
741 CALL dbcsr_create(p_env%p1_admm(ispin)%matrix, &
742 template=matrix_s_aux(1)%matrix)
743 CALL dbcsr_copy(p_env%p1_admm(ispin)%matrix, matrix_s_aux(1)%matrix)
744 CALL dbcsr_set(p_env%p1_admm(ispin)%matrix, 0.0_dp)
748 CALL linres_solver(p_env, qs_env, psi1, cpmos, psi0, iounit, should_stop)
752 CALL dbcsr_copy(p_env%p1(ispin)%matrix, matrix_s(1)%matrix)
756 CALL dbcsr_scale(p_env%p1(ispin)%matrix, 0.5_dp)
758 IF (dft_control%do_admm)
THEN
760 cpassert(
ASSOCIATED(admm_env%work_orb_orb))
761 cpassert(
ASSOCIATED(admm_env%work_aux_orb))
762 cpassert(
ASSOCIATED(admm_env%work_aux_aux))
763 nao = admm_env%nao_orb
764 nao_aux = admm_env%nao_aux_fit
767 CALL parallel_gemm(
'N',
'N', nao_aux, nao, nao, &
768 1.0_dp, admm_env%A, admm_env%work_orb_orb, 0.0_dp, &
769 admm_env%work_aux_orb)
770 CALL parallel_gemm(
'N',
'T', nao_aux, nao_aux, nao, &
771 1.0_dp, admm_env%work_aux_orb, admm_env%A, 0.0_dp, &
772 admm_env%work_aux_aux)
774 keep_sparsity=.true.)
782 p_env%w1(ispin)%matrix)
784 CALL cp_fm_release(psi0)
785 CALL cp_fm_release(psi1)
787 CALL timestop(handle)
810 SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspace, &
811 matrix_hz, matrix_pz, matrix_pz_admm, matrix_wz, &
812 zehartree, zexc, zexc_aux_fit, rhopz_r, p_env, ex_env, debug)
813 TYPE(qs_environment_type),
POINTER :: qs_env
814 TYPE(pw_r3d_rs_type),
INTENT(IN) :: vh_rspace
815 TYPE(pw_r3d_rs_type),
DIMENSION(:),
POINTER :: vxc_rspace, vtau_rspace, vadmm_rspace
816 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_hz, matrix_pz, matrix_pz_admm, &
818 REAL(kind=
dp),
OPTIONAL :: zehartree, zexc, zexc_aux_fit
819 TYPE(pw_r3d_rs_type),
DIMENSION(:), &
820 INTENT(INOUT),
OPTIONAL :: rhopz_r
821 TYPE(qs_p_env_type),
OPTIONAL :: p_env
822 TYPE(excited_energy_type),
OPTIONAL,
POINTER :: ex_env
823 LOGICAL,
INTENT(IN),
OPTIONAL :: debug
825 CHARACTER(LEN=*),
PARAMETER :: routinen =
'response_force'
827 CHARACTER(LEN=default_string_length) :: basis_type
828 INTEGER :: handle, iounit, ispin, mspin, myfun, &
829 n_rep_hf, nao, nao_aux, natom, nder, &
830 nimages, nocc, nspins
831 INTEGER,
DIMENSION(:, :, :),
POINTER :: cell_to_index
832 LOGICAL :: debug_forces, debug_stress, distribute_fock_matrix, do_ex, do_hfx, gapw, gapw_xc, &
833 hfx_treat_lsd_in_core, resp_only, s_mstruct_changed, use_virial
834 REAL(kind=
dp) :: eh1, ehartree, ekin_mol, eps_filter, &
835 eps_ppnl, exc, exc_aux_fit, fconv, &
836 focc, hartree_gs, hartree_t
837 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: ftot1, ftot2, ftot3
838 REAL(kind=
dp),
DIMENSION(2) :: total_rho_gs, total_rho_t
839 REAL(kind=
dp),
DIMENSION(3) :: fodeb
840 REAL(kind=
dp),
DIMENSION(3, 3) :: h_stress, pv_loc, stdeb, sttot, sttot2
841 TYPE(admm_type),
POINTER :: admm_env
842 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
843 TYPE(cell_type),
POINTER :: cell
844 TYPE(cp_logger_type),
POINTER :: logger
845 TYPE(dbcsr_distribution_type),
POINTER :: dbcsr_dist
846 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_ht, matrix_pd, matrix_pza, &
848 TYPE(dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_h, matrix_p, mhd, mhx, mhy, mhz, &
850 TYPE(dbcsr_type),
POINTER :: dbwork
851 TYPE(dft_control_type),
POINTER :: dft_control
852 TYPE(hartree_local_type),
POINTER :: hartree_local_gs, hartree_local_t
853 TYPE(hfx_type),
DIMENSION(:, :),
POINTER :: x_data
854 TYPE(kg_environment_type),
POINTER :: kg_env
855 TYPE(local_rho_type),
POINTER :: local_rho_set_f, local_rho_set_gs, &
856 local_rho_set_t, local_rho_set_vxc, &
858 TYPE(mo_set_type),
DIMENSION(:),
POINTER :: mos
859 TYPE(mp_para_env_type),
POINTER :: para_env
860 TYPE(neighbor_list_set_p_type),
DIMENSION(:), &
861 POINTER :: sab_aux_fit, sab_orb, sac_ae, sac_ppl, &
863 TYPE(oce_matrix_type),
POINTER :: oce
864 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
865 TYPE(pw_c1d_gs_type) :: rho_tot_gspace, rho_tot_gspace_gs, rho_tot_gspace_t, &
866 rhoz_tot_gspace, v_hartree_gspace_gs, v_hartree_gspace_t, zv_hartree_gspace
867 TYPE(pw_c1d_gs_type),
DIMENSION(:),
POINTER :: rho_g_aux, rho_g_gs, rho_g_t, rhoz_g, &
868 rhoz_g_aux, rhoz_g_xc
869 TYPE(pw_c1d_gs_type),
POINTER :: rho_core
870 TYPE(pw_env_type),
POINTER :: pw_env
871 TYPE(pw_poisson_type),
POINTER :: poisson_env
872 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
873 TYPE(pw_r3d_rs_type) :: v_hartree_rspace_gs, v_hartree_rspace_t, &
874 vhxc_rspace, zv_hartree_rspace
875 TYPE(pw_r3d_rs_type),
DIMENSION(:),
POINTER :: rho_r_aux, rho_r_gs, rho_r_t, rhoz_r, &
876 rhoz_r_aux, rhoz_r_xc, tau_r_aux, &
877 tauz_r, tauz_r_xc, v_xc, v_xc_tau
878 TYPE(qs_force_type),
DIMENSION(:),
POINTER :: force
879 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
880 TYPE(qs_ks_env_type),
POINTER :: ks_env
881 TYPE(qs_rho_type),
POINTER :: rho, rho_aux_fit, rho_xc
882 TYPE(section_vals_type),
POINTER :: hfx_section, xc_fun_section, xc_section
883 TYPE(task_list_type),
POINTER :: task_list, task_list_aux_fit
884 TYPE(virial_type),
POINTER :: virial
886 CALL timeset(routinen, handle)
888 IF (
PRESENT(debug))
THEN
892 debug_forces = .false.
893 debug_stress = .false.
898 IF (logger%para_env%is_source())
THEN
905 IF (
PRESENT(ex_env)) do_ex = .true.
907 cpassert(
PRESENT(p_env))
910 NULLIFY (ks_env, sab_orb, sac_ae, sac_ppl, sap_ppnl, virial)
915 dft_control=dft_control, &
922 nspins = dft_control%nspins
923 gapw = dft_control%qs_control%gapw
924 gapw_xc = dft_control%qs_control%gapw_xc
926 IF (debug_forces)
THEN
927 CALL get_qs_env(qs_env, natom=natom, atomic_kind_set=atomic_kind_set)
928 ALLOCATE (ftot1(3, natom))
933 use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)
935 fconv = 1.0e-9_dp*
pascal/cell%deth
936 IF (debug_stress .AND. use_virial)
THEN
937 sttot = virial%pv_virial
947 ALLOCATE (mpa(ispin)%matrix)
948 CALL dbcsr_create(mpa(ispin)%matrix, template=p_env%p1(ispin)%matrix)
949 CALL dbcsr_copy(mpa(ispin)%matrix, p_env%p1(ispin)%matrix)
950 CALL dbcsr_add(mpa(ispin)%matrix, ex_env%matrix_pe(ispin)%matrix, 1.0_dp, 1.0_dp)
951 CALL dbcsr_set(matrix_hz(ispin)%matrix, 0.0_dp)
956 ALLOCATE (matrix_ht(ispin)%matrix)
957 CALL dbcsr_create(matrix_ht(ispin)%matrix, template=matrix_hz(ispin)%matrix)
958 CALL dbcsr_copy(matrix_ht(ispin)%matrix, matrix_hz(ispin)%matrix)
959 CALL dbcsr_set(matrix_ht(ispin)%matrix, 0.0_dp)
967 IF (nspins == 2)
THEN
968 CALL dbcsr_add(mpa(1)%matrix, mpa(2)%matrix, 1.0_dp, 1.0_dp)
974 IF (debug_forces) fodeb(1:3) = force(1)%kinetic(1:3, 1)
975 IF (debug_stress .AND. use_virial) stdeb = virial%pv_ekinetic
977 matrix_name=
"KINETIC ENERGY MATRIX", &
979 sab_nl=sab_orb, calculate_forces=.true., &
980 matrix_p=mpa(1)%matrix)
981 IF (debug_forces)
THEN
982 fodeb(1:3) = force(1)%kinetic(1:3, 1) - fodeb(1:3)
983 CALL para_env%sum(fodeb)
984 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dT ", fodeb
986 IF (debug_stress .AND. use_virial)
THEN
987 stdeb = fconv*(virial%pv_ekinetic - stdeb)
988 CALL para_env%sum(stdeb)
989 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
993 IF (nspins == 2)
THEN
994 CALL dbcsr_add(mpa(1)%matrix, mpa(2)%matrix, 1.0_dp, -1.0_dp)
999 CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s)
1001 DO ispin = 1, nspins
1002 ALLOCATE (scrm(ispin)%matrix)
1003 CALL dbcsr_create(scrm(ispin)%matrix, template=matrix_s(1)%matrix)
1004 CALL dbcsr_copy(scrm(ispin)%matrix, matrix_s(1)%matrix)
1005 CALL dbcsr_set(scrm(ispin)%matrix, 0.0_dp)
1008 CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, particle_set=particle_set, &
1009 atomic_kind_set=atomic_kind_set)
1011 NULLIFY (cell_to_index)
1012 ALLOCATE (matrix_p(nspins, 1), matrix_h(nspins, 1))
1013 DO ispin = 1, nspins
1014 matrix_p(ispin, 1)%matrix => mpa(ispin)%matrix
1015 matrix_h(ispin, 1)%matrix => scrm(ispin)%matrix
1017 matrix_h(1, 1)%matrix => scrm(1)%matrix
1019 IF (
ASSOCIATED(sac_ae))
THEN
1021 IF (debug_forces) fodeb(1:3) = force(1)%all_potential(1:3, 1)
1022 IF (debug_stress .AND. use_virial) stdeb = virial%pv_ppl
1023 CALL build_core_ae(matrix_h, matrix_p, force, virial, .true., use_virial, nder, &
1024 qs_kind_set, atomic_kind_set, particle_set, sab_orb, sac_ae, &
1025 nimages, cell_to_index)
1026 IF (debug_forces)
THEN
1027 fodeb(1:3) = force(1)%all_potential(1:3, 1) - fodeb(1:3)
1028 CALL para_env%sum(fodeb)
1029 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dHae ", fodeb
1031 IF (debug_stress .AND. use_virial)
THEN
1032 stdeb = fconv*(virial%pv_ppl - stdeb)
1033 CALL para_env%sum(stdeb)
1034 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1039 IF (
ASSOCIATED(sac_ppl))
THEN
1041 IF (debug_forces) fodeb(1:3) = force(1)%gth_ppl(1:3, 1)
1042 IF (debug_stress .AND. use_virial) stdeb = virial%pv_ppl
1044 virial, .true., use_virial, nder, &
1045 qs_kind_set, atomic_kind_set, particle_set, &
1046 sab_orb, sac_ppl, nimages, cell_to_index,
"ORB")
1047 IF (debug_forces)
THEN
1048 fodeb(1:3) = force(1)%gth_ppl(1:3, 1) - fodeb(1:3)
1049 CALL para_env%sum(fodeb)
1050 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dHppl ", fodeb
1052 IF (debug_stress .AND. use_virial)
THEN
1053 stdeb = fconv*(virial%pv_ppl - stdeb)
1054 CALL para_env%sum(stdeb)
1055 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1059 eps_ppnl = dft_control%qs_control%eps_ppnl
1060 IF (
ASSOCIATED(sap_ppnl))
THEN
1062 IF (debug_forces) fodeb(1:3) = force(1)%gth_ppnl(1:3, 1)
1063 IF (debug_stress .AND. use_virial) stdeb = virial%pv_ppnl
1065 virial, .true., use_virial, nder, &
1066 qs_kind_set, atomic_kind_set, particle_set, &
1067 sab_orb, sap_ppnl, eps_ppnl, nimages, cell_to_index,
"ORB")
1068 IF (debug_forces)
THEN
1069 fodeb(1:3) = force(1)%gth_ppnl(1:3, 1) - fodeb(1:3)
1070 CALL para_env%sum(fodeb)
1071 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dHppnl ", fodeb
1073 IF (debug_stress .AND. use_virial)
THEN
1074 stdeb = fconv*(virial%pv_ppnl - stdeb)
1075 CALL para_env%sum(stdeb)
1076 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1083 IF (dft_control%qs_control%do_kg)
THEN
1085 CALL get_qs_env(qs_env=qs_env, kg_env=kg_env, dbcsr_dist=dbcsr_dist)
1087 IF (use_virial)
THEN
1088 pv_loc = virial%pv_virial
1091 IF (debug_forces) fodeb(1:3) = force(1)%kinetic(1:3, 1)
1092 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1093 CALL build_tnadd_mat(kg_env=kg_env, matrix_p=matrix_p, force=force, virial=virial, &
1094 calculate_forces=.true., use_virial=use_virial, &
1095 qs_kind_set=qs_kind_set, atomic_kind_set=atomic_kind_set, &
1096 particle_set=particle_set, sab_orb=sab_orb, dbcsr_dist=dbcsr_dist)
1097 IF (debug_forces)
THEN
1098 fodeb(1:3) = force(1)%kinetic(1:3, 1) - fodeb(1:3)
1099 CALL para_env%sum(fodeb)
1100 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dTnadd ", fodeb
1102 IF (debug_stress .AND. use_virial)
THEN
1103 stdeb = fconv*(virial%pv_virial - stdeb)
1104 CALL para_env%sum(stdeb)
1105 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1110 IF (use_virial)
THEN
1111 virial%pv_ekinetic = virial%pv_ekinetic + (virial%pv_virial - pv_loc)
1117 DEALLOCATE (matrix_h)
1118 DEALLOCATE (matrix_p)
1126 DO ispin = 1, nspins
1127 ALLOCATE (scrm(ispin)%matrix)
1128 CALL dbcsr_create(scrm(ispin)%matrix, template=matrix_pz(1)%matrix)
1129 CALL dbcsr_copy(scrm(ispin)%matrix, matrix_pz(ispin)%matrix)
1130 CALL dbcsr_set(scrm(ispin)%matrix, 0.0_dp)
1133 IF (debug_forces)
THEN
1134 ALLOCATE (ftot2(3, natom))
1136 fodeb(1:3) = ftot2(1:3, 1) - ftot1(1:3, 1)
1137 CALL para_env%sum(fodeb)
1138 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dHcore", fodeb
1140 IF (debug_stress .AND. use_virial)
THEN
1141 stdeb = fconv*(virial%pv_virial - sttot)
1142 CALL para_env%sum(stdeb)
1143 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1146 sttot2 = virial%pv_virial
1154 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, poisson_env=poisson_env)
1156 IF (dft_control%do_admm)
THEN
1158 xc_section => admm_env%xc_section_primary
1165 IF (gapw .OR. gapw_xc)
THEN
1166 NULLIFY (oce, sab_orb)
1167 CALL get_qs_env(qs_env=qs_env, oce=oce, sab_orb=sab_orb)
1169 NULLIFY (local_rho_set_gs)
1174 qs_kind_set, dft_control, para_env)
1175 CALL init_rho0(local_rho_set_gs, qs_env, dft_control%qs_control%gapw_control)
1178 qs_kind_set, oce, sab_orb, para_env)
1181 NULLIFY (local_rho_set_t)
1184 qs_kind_set, dft_control, para_env)
1185 CALL init_rho0(local_rho_set_t, qs_env, dft_control%qs_control%gapw_control, &
1189 qs_kind_set, oce, sab_orb, para_env)
1193 ALLOCATE (rho_r_gs(nspins), rho_g_gs(nspins))
1194 DO ispin = 1, nspins
1195 CALL auxbas_pw_pool%create_pw(rho_r_gs(ispin))
1196 CALL auxbas_pw_pool%create_pw(rho_g_gs(ispin))
1198 CALL auxbas_pw_pool%create_pw(rho_tot_gspace_gs)
1200 total_rho_gs = 0.0_dp
1201 CALL pw_zero(rho_tot_gspace_gs)
1202 DO ispin = 1, nspins
1204 rho=rho_r_gs(ispin), &
1205 rho_gspace=rho_g_gs(ispin), &
1206 soft_valid=(gapw .OR. gapw_xc), &
1207 total_rho=total_rho_gs(ispin))
1208 CALL pw_axpy(rho_g_gs(ispin), rho_tot_gspace_gs)
1213 CALL pw_axpy(local_rho_set_gs%rho0_mpole%rho0_s_gs, rho_tot_gspace_gs)
1214 IF (dft_control%qs_control%gapw_control%nopaw_as_gpw)
THEN
1215 CALL get_qs_env(qs_env=qs_env, rho_core=rho_core)
1216 CALL pw_axpy(rho_core, rho_tot_gspace_gs)
1219 CALL auxbas_pw_pool%create_pw(v_hartree_gspace_gs)
1220 CALL auxbas_pw_pool%create_pw(v_hartree_rspace_gs)
1221 NULLIFY (hartree_local_gs)
1224 CALL pw_poisson_solve(poisson_env, rho_tot_gspace_gs, hartree_gs, v_hartree_gspace_gs)
1225 CALL pw_transfer(v_hartree_gspace_gs, v_hartree_rspace_gs)
1226 CALL pw_scale(v_hartree_rspace_gs, v_hartree_rspace_gs%pw_grid%dvol)
1233 cpassert(.NOT. use_virial)
1234 IF (debug_forces) fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1)
1235 CALL vh_1c_gg_integrals(qs_env, hartree_gs, hartree_local_gs%ecoul_1c, local_rho_set_t, para_env, tddft=.true., &
1236 local_rho_set_2nd=local_rho_set_gs, core_2nd=.false.)
1239 local_rho_set=local_rho_set_t, local_rho_set_2nd=local_rho_set_gs)
1240 IF (debug_forces)
THEN
1241 fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1) - fodeb(1:3)
1242 CALL para_env%sum(fodeb)
1243 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: (T+Dz)*dVh[D^GS]PAWg0", fodeb
1246 IF (gapw .OR. gapw_xc)
THEN
1249 NULLIFY (local_rho_set_vxc)
1252 qs_kind_set, dft_control, para_env)
1254 qs_kind_set, oce, sab_orb, para_env)
1257 CALL calculate_vxc_atom(qs_env, .false., exc1=hartree_gs, xc_section_external=xc_section, &
1258 rho_atom_set_external=local_rho_set_vxc%rho_atom_set)
1262 CALL auxbas_pw_pool%create_pw(vhxc_rspace)
1266 IF (use_virial)
THEN
1267 pv_loc = virial%pv_virial
1270 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1271 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1272 IF (gapw .OR. gapw_xc)
THEN
1274 DO ispin = 1, nspins
1275 CALL pw_zero(vhxc_rspace)
1277 CALL pw_transfer(v_hartree_rspace_gs, vhxc_rspace)
1278 ELSEIF (gapw_xc)
THEN
1279 CALL pw_transfer(vh_rspace, vhxc_rspace)
1281 CALL integrate_v_rspace(v_rspace=vhxc_rspace, &
1282 hmat=scrm(ispin), pmat=mpa(ispin), &
1283 qs_env=qs_env, gapw=gapw, &
1284 calculate_forces=.true.)
1287 DO ispin = 1, nspins
1288 CALL pw_zero(vhxc_rspace)
1289 CALL pw_axpy(vxc_rspace(ispin), vhxc_rspace)
1290 CALL integrate_v_rspace(v_rspace=vhxc_rspace, &
1291 hmat=scrm(ispin), pmat=mpa(ispin), &
1292 qs_env=qs_env, gapw=(gapw .OR. gapw_xc), &
1293 calculate_forces=.true.)
1297 DO ispin = 1, nspins
1298 CALL pw_transfer(vh_rspace, vhxc_rspace)
1299 CALL pw_axpy(vxc_rspace(ispin), vhxc_rspace)
1300 CALL integrate_v_rspace(v_rspace=vhxc_rspace, &
1301 hmat=scrm(ispin), pmat=mpa(ispin), &
1302 qs_env=qs_env, gapw=gapw, calculate_forces=.true.)
1306 IF (debug_forces)
THEN
1307 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1308 CALL para_env%sum(fodeb)
1309 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: (T+Dz)*dVhxc[D^GS] ", fodeb
1311 IF (debug_stress .AND. use_virial)
THEN
1312 stdeb = fconv*(virial%pv_virial - pv_loc)
1313 CALL para_env%sum(stdeb)
1314 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1318 IF (gapw .OR. gapw_xc)
THEN
1321 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
1322 IF (gapw)
CALL update_ks_atom(qs_env, scrm, mpa, forces=.true., tddft=.false., &
1323 rho_atom_external=local_rho_set_gs%rho_atom_set)
1325 rho_atom_external=local_rho_set_vxc%rho_atom_set)
1326 IF (debug_forces)
THEN
1327 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
1328 CALL para_env%sum(fodeb)
1329 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: (T+Dz)*dVhxc[D^GS]PAW ", fodeb
1338 CALL auxbas_pw_pool%give_back_pw(v_hartree_gspace_gs)
1339 CALL auxbas_pw_pool%give_back_pw(v_hartree_rspace_gs)
1341 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace_gs)
1342 IF (
ASSOCIATED(rho_r_gs))
THEN
1343 DO ispin = 1, nspins
1344 CALL auxbas_pw_pool%give_back_pw(rho_r_gs(ispin))
1346 DEALLOCATE (rho_r_gs)
1348 IF (
ASSOCIATED(rho_g_gs))
THEN
1349 DO ispin = 1, nspins
1350 CALL auxbas_pw_pool%give_back_pw(rho_g_gs(ispin))
1352 DEALLOCATE (rho_g_gs)
1356 IF (
ASSOCIATED(vtau_rspace))
THEN
1357 cpassert(.NOT. (gapw .OR. gapw_xc))
1358 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1359 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1360 DO ispin = 1, nspins
1361 CALL integrate_v_rspace(v_rspace=vtau_rspace(ispin), &
1362 hmat=scrm(ispin), pmat=mpa(ispin), &
1363 qs_env=qs_env, gapw=(gapw .OR. gapw_xc), &
1364 calculate_forces=.true., compute_tau=.true.)
1366 IF (debug_forces)
THEN
1367 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1368 CALL para_env%sum(fodeb)
1369 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dVxc_tau ", fodeb
1371 IF (debug_stress .AND. use_virial)
THEN
1372 stdeb = fconv*(virial%pv_virial - pv_loc)
1373 CALL para_env%sum(stdeb)
1374 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1378 CALL auxbas_pw_pool%give_back_pw(vhxc_rspace)
1381 IF (use_virial)
THEN
1382 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1387 IF (dft_control%qs_control%do_kg)
THEN
1392 IF (use_virial)
THEN
1393 pv_loc = virial%pv_virial
1396 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1399 ekin_mol=ekin_mol, &
1400 calc_force=.true., &
1401 do_kernel=.false., &
1403 IF (debug_forces)
THEN
1404 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1405 CALL para_env%sum(fodeb)
1406 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dVkg ", fodeb
1408 IF (debug_stress .AND. use_virial)
THEN
1411 stdeb = 1.0_dp*fconv*ekin_mol
1412 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1415 stdeb = fconv*(virial%pv_virial - pv_loc)
1416 CALL para_env%sum(stdeb)
1417 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1420 stdeb = fconv*virial%pv_xc
1421 CALL para_env%sum(stdeb)
1422 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1425 IF (use_virial)
THEN
1427 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1438 ALLOCATE (rhoz_r(nspins), rhoz_g(nspins))
1439 DO ispin = 1, nspins
1440 CALL auxbas_pw_pool%create_pw(rhoz_r(ispin))
1441 CALL auxbas_pw_pool%create_pw(rhoz_g(ispin))
1443 CALL auxbas_pw_pool%create_pw(rhoz_tot_gspace)
1444 CALL auxbas_pw_pool%create_pw(zv_hartree_rspace)
1445 CALL auxbas_pw_pool%create_pw(zv_hartree_gspace)
1447 CALL pw_zero(rhoz_tot_gspace)
1448 DO ispin = 1, nspins
1450 rho=rhoz_r(ispin), rho_gspace=rhoz_g(ispin), &
1452 CALL pw_axpy(rhoz_g(ispin), rhoz_tot_gspace)
1456 ALLOCATE (rhoz_r_xc(nspins), rhoz_g_xc(nspins))
1457 DO ispin = 1, nspins
1458 CALL auxbas_pw_pool%create_pw(rhoz_r_xc(ispin))
1459 CALL auxbas_pw_pool%create_pw(rhoz_g_xc(ispin))
1461 DO ispin = 1, nspins
1463 rho=rhoz_r_xc(ispin), rho_gspace=rhoz_g_xc(ispin), &
1468 IF (
ASSOCIATED(vtau_rspace))
THEN
1469 cpassert(.NOT. (gapw .OR. gapw_xc))
1471 TYPE(pw_c1d_gs_type) :: work_g
1472 ALLOCATE (tauz_r(nspins))
1473 CALL auxbas_pw_pool%create_pw(work_g)
1474 DO ispin = 1, nspins
1475 CALL auxbas_pw_pool%create_pw(tauz_r(ispin))
1477 rho=tauz_r(ispin), rho_gspace=work_g, &
1480 CALL auxbas_pw_pool%give_back_pw(work_g)
1485 IF (
PRESENT(rhopz_r))
THEN
1486 DO ispin = 1, nspins
1487 CALL pw_copy(rhoz_r(ispin), rhopz_r(ispin))
1494 IF (use_virial)
THEN
1497 CALL auxbas_pw_pool%create_pw(rho_tot_gspace)
1502 h_stress(:, :) = 0.0_dp
1509 CALL pw_poisson_solve(poisson_env, &
1510 density=rhoz_tot_gspace, &
1511 ehartree=ehartree, &
1512 vhartree=zv_hartree_gspace, &
1513 h_stress=h_stress, &
1514 aux_density=rho_tot_gspace)
1516 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace)
1519 virial%pv_ehartree = virial%pv_ehartree + 2.0_dp*h_stress/real(para_env%num_pe,
dp)
1520 virial%pv_virial = virial%pv_virial + 2.0_dp*h_stress/real(para_env%num_pe,
dp)
1522 IF (debug_stress)
THEN
1523 stdeb = -1.0_dp*fconv*ehartree
1524 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1526 stdeb = -1.0_dp*fconv*ehartree
1527 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1529 stdeb = fconv*(h_stress/real(para_env%num_pe,
dp))
1530 CALL para_env%sum(stdeb)
1531 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1533 stdeb = fconv*(h_stress/real(para_env%num_pe,
dp))
1534 CALL para_env%sum(stdeb)
1535 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1542 DO ispin = 1, nspins
1543 exc = exc + pw_integral_ab(rhoz_r(ispin), vxc_rspace(ispin))/ &
1544 vxc_rspace(ispin)%pw_grid%dvol
1546 IF (
ASSOCIATED(vtau_rspace))
THEN
1547 DO ispin = 1, nspins
1548 exc = exc + pw_integral_ab(tauz_r(ispin), vtau_rspace(ispin))/ &
1549 vtau_rspace(ispin)%pw_grid%dvol
1554 IF (dft_control%qs_control%do_kg)
THEN
1557 exc = exc - ekin_mol
1561 IF (debug_stress)
THEN
1562 stdeb = -1.0_dp*fconv*exc
1563 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1572 CALL pw_axpy(local_rho_set_t%rho0_mpole%rho0_s_gs, rhoz_tot_gspace)
1574 CALL pw_poisson_solve(poisson_env, rhoz_tot_gspace, ehartree, zv_hartree_gspace)
1577 IF (gapw .OR. gapw_xc)
THEN
1581 IF (debug_forces) fodeb(1:3) = force(1)%rho_core(1:3, 1)
1582 IF (debug_stress .AND. use_virial) stdeb = virial%pv_ehartree
1583 CALL pw_transfer(zv_hartree_gspace, zv_hartree_rspace)
1584 CALL pw_scale(zv_hartree_rspace, zv_hartree_rspace%pw_grid%dvol)
1586 CALL integrate_v_core_rspace(zv_hartree_rspace, qs_env)
1587 IF (debug_forces)
THEN
1588 fodeb(1:3) = force(1)%rho_core(1:3, 1) - fodeb(1:3)
1589 CALL para_env%sum(fodeb)
1590 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Vh(rhoz)*dncore ", fodeb
1592 IF (debug_stress .AND. use_virial)
THEN
1593 stdeb = fconv*(virial%pv_ehartree - stdeb)
1594 CALL para_env%sum(stdeb)
1595 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1601 CALL get_qs_env(qs_env=qs_env, rho_xc=rho_xc)
1605 IF (dft_control%do_admm)
THEN
1607 xc_section => admm_env%xc_section_primary
1612 IF (use_virial)
THEN
1613 virial%pv_xc = 0.0_dp
1616 NULLIFY (v_xc, v_xc_tau)
1619 rho=rho_xc, rho1_r=rhoz_r_xc, rho1_g=rhoz_g_xc, tau1_r=tauz_r_xc, &
1620 xc_section=xc_section, compute_virial=use_virial, virial_xc=virial%pv_xc)
1623 rho=rho, rho1_r=rhoz_r, rho1_g=rhoz_g, tau1_r=tauz_r, &
1624 xc_section=xc_section, compute_virial=use_virial, virial_xc=virial%pv_xc)
1627 IF (gapw .OR. gapw_xc)
THEN
1629 NULLIFY (local_rho_set_t)
1632 qs_kind_set, dft_control, para_env)
1633 CALL init_rho0(local_rho_set_t, qs_env, dft_control%qs_control%gapw_control, &
1637 qs_kind_set, oce, sab_orb, para_env)
1639 NULLIFY (local_rho_set_gs)
1642 qs_kind_set, dft_control, para_env)
1643 CALL init_rho0(local_rho_set_gs, qs_env, dft_control%qs_control%gapw_control)
1646 qs_kind_set, oce, sab_orb, para_env)
1649 ALLOCATE (rho_r_t(nspins), rho_g_t(nspins))
1650 DO ispin = 1, nspins
1651 CALL auxbas_pw_pool%create_pw(rho_r_t(ispin))
1652 CALL auxbas_pw_pool%create_pw(rho_g_t(ispin))
1654 CALL auxbas_pw_pool%create_pw(rho_tot_gspace_t)
1655 total_rho_t = 0.0_dp
1656 CALL pw_zero(rho_tot_gspace_t)
1657 DO ispin = 1, nspins
1659 rho=rho_r_t(ispin), &
1660 rho_gspace=rho_g_t(ispin), &
1662 total_rho=total_rho_t(ispin))
1663 CALL pw_axpy(rho_g_t(ispin), rho_tot_gspace_t)
1667 CALL pw_axpy(local_rho_set_t%rho0_mpole%rho0_s_gs, rho_tot_gspace_t)
1669 CALL auxbas_pw_pool%create_pw(v_hartree_gspace_t)
1670 CALL auxbas_pw_pool%create_pw(v_hartree_rspace_t)
1671 NULLIFY (hartree_local_t)
1674 CALL pw_poisson_solve(poisson_env, rho_tot_gspace_t, hartree_t, v_hartree_gspace_t)
1675 CALL pw_transfer(v_hartree_gspace_t, v_hartree_rspace_t)
1676 CALL pw_scale(v_hartree_rspace_t, v_hartree_rspace_t%pw_grid%dvol)
1678 IF (debug_forces) fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1)
1679 CALL vh_1c_gg_integrals(qs_env, hartree_t, hartree_local_t%ecoul_1c, local_rho_set_gs, para_env, tddft=.false., &
1680 local_rho_set_2nd=local_rho_set_t, core_2nd=.true.)
1682 local_rho_set=local_rho_set_gs, local_rho_set_2nd=local_rho_set_t)
1683 IF (debug_forces)
THEN
1684 fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1) - fodeb(1:3)
1685 CALL para_env%sum(fodeb)
1686 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Vh(T)*dncore PAWg0", fodeb
1691 IF (gapw .OR. gapw_xc)
THEN
1695 NULLIFY (local_rho_set_f)
1698 qs_kind_set, dft_control, para_env)
1700 qs_kind_set, oce, sab_orb, para_env)
1704 local_rho_set_f%rho_atom_set, &
1705 qs_env, xc_section, para_env, &
1706 do_tddft=.false., do_triplet=.false.)
1711 IF (use_virial)
THEN
1712 virial%pv_exc = virial%pv_exc + virial%pv_xc
1713 virial%pv_virial = virial%pv_virial + virial%pv_xc
1716 IF (debug_stress .AND. use_virial)
THEN
1717 stdeb = 1.0_dp*fconv*virial%pv_xc
1718 CALL para_env%sum(stdeb)
1719 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1724 IF (use_virial)
THEN
1725 pv_loc = virial%pv_virial
1730 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1732 DO ispin = 1, nspins
1733 CALL pw_scale(v_xc(ispin), v_xc(ispin)%pw_grid%dvol)
1735 IF ((.NOT. (gapw)) .AND. (.NOT. gapw_xc))
THEN
1736 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1737 DO ispin = 1, nspins
1738 CALL pw_axpy(zv_hartree_rspace, v_xc(ispin))
1739 CALL integrate_v_rspace(qs_env=qs_env, &
1740 v_rspace=v_xc(ispin), &
1741 hmat=matrix_hz(ispin), &
1742 pmat=matrix_p(ispin, 1), &
1744 calculate_forces=.true.)
1746 IF (debug_forces)
THEN
1747 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1748 CALL para_env%sum(fodeb)
1749 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dKhxc*rhoz ", fodeb
1752 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1754 DO ispin = 1, nspins
1755 CALL integrate_v_rspace(qs_env=qs_env, &
1756 v_rspace=v_xc(ispin), &
1757 hmat=matrix_hz(ispin), &
1758 pmat=matrix_p(ispin, 1), &
1760 calculate_forces=.true.)
1764 DO ispin = 1, nspins
1765 CALL pw_zero(v_xc(ispin))
1767 CALL pw_axpy(v_hartree_rspace_t, v_xc(ispin))
1768 ELSEIF (gapw_xc)
THEN
1769 CALL pw_axpy(zv_hartree_rspace, v_xc(ispin))
1771 CALL integrate_v_rspace(qs_env=qs_env, &
1772 v_rspace=v_xc(ispin), &
1773 hmat=matrix_ht(ispin), &
1774 pmat=matrix_p(ispin, 1), &
1776 calculate_forces=.true.)
1778 IF (debug_forces)
THEN
1779 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1780 CALL para_env%sum(fodeb)
1781 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dKhxc*rhoz ", fodeb
1785 IF (gapw .OR. gapw_xc)
THEN
1788 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
1789 CALL update_ks_atom(qs_env, matrix_hz, matrix_p, forces=.true., tddft=.false., &
1790 rho_atom_external=local_rho_set_f%rho_atom_set)
1791 IF (debug_forces)
THEN
1792 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
1793 CALL para_env%sum(fodeb)
1794 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P^GS*dKxc*(Dz+T) PAW", fodeb
1799 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
1800 CALL update_ks_atom(qs_env, matrix_ht, matrix_p, forces=.true., tddft=.false., &
1801 rho_atom_external=local_rho_set_t%rho_atom_set)
1802 IF (debug_forces)
THEN
1803 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
1804 CALL para_env%sum(fodeb)
1805 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P^GS*dKh*(Dz+T) PAW", fodeb
1809 DO ispin = 1, nspins
1810 CALL dbcsr_add(matrix_hz(ispin)%matrix, matrix_ht(ispin)%matrix, 1.0_dp, 1.0_dp)
1821 CALL auxbas_pw_pool%give_back_pw(v_hartree_gspace_t)
1822 CALL auxbas_pw_pool%give_back_pw(v_hartree_rspace_t)
1824 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace_t)
1825 DO ispin = 1, nspins
1826 CALL auxbas_pw_pool%give_back_pw(rho_r_t(ispin))
1827 CALL auxbas_pw_pool%give_back_pw(rho_g_t(ispin))
1829 DEALLOCATE (rho_r_t, rho_g_t)
1832 IF (debug_stress .AND. use_virial)
THEN
1833 stdeb = fconv*(virial%pv_virial - stdeb)
1834 CALL para_env%sum(stdeb)
1835 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1839 IF (
ASSOCIATED(v_xc_tau))
THEN
1840 cpassert(.NOT. (gapw .OR. gapw_xc))
1841 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1842 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1843 DO ispin = 1, nspins
1844 CALL pw_scale(v_xc_tau(ispin), v_xc_tau(ispin)%pw_grid%dvol)
1845 CALL integrate_v_rspace(qs_env=qs_env, &
1846 v_rspace=v_xc_tau(ispin), &
1847 hmat=matrix_hz(ispin), &
1848 pmat=matrix_p(ispin, 1), &
1849 compute_tau=.true., &
1850 gapw=(gapw .OR. gapw_xc), &
1851 calculate_forces=.true.)
1853 IF (debug_forces)
THEN
1854 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1855 CALL para_env%sum(fodeb)
1856 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dKtau*tauz ", fodeb
1859 IF (debug_stress .AND. use_virial)
THEN
1860 stdeb = fconv*(virial%pv_virial - stdeb)
1861 CALL para_env%sum(stdeb)
1862 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1866 IF (use_virial)
THEN
1867 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1872 IF (dft_control%qs_control%do_kg)
THEN
1875 IF (use_virial)
THEN
1876 pv_loc = virial%pv_virial
1879 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1880 IF (use_virial) virial%pv_xc = 0.0_dp
1882 ks_matrix=matrix_hz, &
1883 ekin_mol=ekin_mol, &
1884 calc_force=.true., &
1888 IF (debug_forces)
THEN
1889 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1890 CALL para_env%sum(fodeb)
1891 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*d(Kkg)*rhoz ", fodeb
1893 IF (debug_stress .AND. use_virial)
THEN
1894 stdeb = fconv*(virial%pv_virial - pv_loc)
1895 CALL para_env%sum(stdeb)
1896 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1899 stdeb = fconv*(virial%pv_xc)
1900 CALL para_env%sum(stdeb)
1901 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1906 IF (use_virial)
THEN
1908 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1911 virial%pv_exc = virial%pv_exc - virial%pv_xc
1912 virial%pv_virial = virial%pv_virial - virial%pv_xc
1913 virial%pv_xc = 0.0_dp
1917 CALL auxbas_pw_pool%give_back_pw(rhoz_tot_gspace)
1918 CALL auxbas_pw_pool%give_back_pw(zv_hartree_gspace)
1919 CALL auxbas_pw_pool%give_back_pw(zv_hartree_rspace)
1920 DO ispin = 1, nspins
1921 CALL auxbas_pw_pool%give_back_pw(rhoz_r(ispin))
1922 CALL auxbas_pw_pool%give_back_pw(rhoz_g(ispin))
1923 CALL auxbas_pw_pool%give_back_pw(v_xc(ispin))
1925 DEALLOCATE (rhoz_r, rhoz_g, v_xc)
1927 DO ispin = 1, nspins
1928 CALL auxbas_pw_pool%give_back_pw(rhoz_r_xc(ispin))
1929 CALL auxbas_pw_pool%give_back_pw(rhoz_g_xc(ispin))
1931 DEALLOCATE (rhoz_r_xc, rhoz_g_xc)
1933 IF (
ASSOCIATED(v_xc_tau))
THEN
1934 DO ispin = 1, nspins
1935 CALL auxbas_pw_pool%give_back_pw(tauz_r(ispin))
1936 CALL auxbas_pw_pool%give_back_pw(v_xc_tau(ispin))
1938 DEALLOCATE (tauz_r, v_xc_tau)
1940 IF (debug_forces)
THEN
1941 ALLOCATE (ftot3(3, natom))
1943 fodeb(1:3) = ftot3(1:3, 1) - ftot2(1:3, 1)
1944 CALL para_env%sum(fodeb)
1945 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*V(rhoz)", fodeb
1954 IF (dft_control%do_admm)
THEN
1956 exc_aux_fit = 0.0_dp
1960 NULLIFY (mpz, mhz, mhx, mhy)
1964 CALL get_admm_env(admm_env, rho_aux_fit=rho_aux_fit, matrix_s_aux_fit=scrm, &
1965 task_list_aux_fit=task_list_aux_fit)
1967 NULLIFY (mpz, mhz, mhx, mhy)
1971 DO ispin = 1, nspins
1972 ALLOCATE (mhx(ispin, 1)%matrix)
1973 CALL dbcsr_create(mhx(ispin, 1)%matrix, template=scrm(1)%matrix)
1974 CALL dbcsr_copy(mhx(ispin, 1)%matrix, scrm(1)%matrix)
1975 CALL dbcsr_set(mhx(ispin, 1)%matrix, 0.0_dp)
1976 ALLOCATE (mhy(ispin, 1)%matrix)
1977 CALL dbcsr_create(mhy(ispin, 1)%matrix, template=scrm(1)%matrix)
1978 CALL dbcsr_copy(mhy(ispin, 1)%matrix, scrm(1)%matrix)
1979 CALL dbcsr_set(mhy(ispin, 1)%matrix, 0.0_dp)
1980 ALLOCATE (mpz(ispin, 1)%matrix)
1982 CALL dbcsr_create(mpz(ispin, 1)%matrix, template=p_env%p1_admm(ispin)%matrix)
1983 CALL dbcsr_copy(mpz(ispin, 1)%matrix, p_env%p1_admm(ispin)%matrix)
1984 CALL dbcsr_add(mpz(ispin, 1)%matrix, ex_env%matrix_pe_admm(ispin)%matrix, &
1987 CALL dbcsr_create(mpz(ispin, 1)%matrix, template=matrix_pz_admm(ispin)%matrix)
1988 CALL dbcsr_copy(mpz(ispin, 1)%matrix, matrix_pz_admm(ispin)%matrix)
1992 xc_section => admm_env%xc_section_aux
1995 IF (use_virial)
THEN
1996 pv_loc = virial%pv_virial
1999 basis_type =
"AUX_FIT"
2000 task_list => task_list_aux_fit
2001 IF (admm_env%do_gapw)
THEN
2002 basis_type =
"AUX_FIT_SOFT"
2003 task_list => admm_env%admm_gapw_env%task_list
2006 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
2007 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
2008 DO ispin = 1, nspins
2009 CALL integrate_v_rspace(v_rspace=vadmm_rspace(ispin), &
2010 hmat=mhx(ispin, 1), pmat=mpz(ispin, 1), &
2011 qs_env=qs_env, calculate_forces=.true., &
2012 basis_type=basis_type, task_list_external=task_list)
2014 IF (debug_forces)
THEN
2015 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
2016 CALL para_env%sum(fodeb)
2017 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*Vxc(rho_admm)", fodeb
2019 IF (debug_stress .AND. use_virial)
THEN
2020 stdeb = fconv*(virial%pv_virial - pv_loc)
2021 CALL para_env%sum(stdeb)
2022 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2026 IF (use_virial)
THEN
2027 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
2030 IF (admm_env%do_gapw)
THEN
2032 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
2033 CALL update_ks_atom(qs_env, mhx(:, 1), mpz(:, 1), forces=.true., tddft=.false., &
2034 rho_atom_external=admm_env%admm_gapw_env%local_rho_set%rho_atom_set, &
2035 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
2036 oce_external=admm_env%admm_gapw_env%oce, &
2037 sab_external=sab_aux_fit)
2038 IF (debug_forces)
THEN
2039 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
2040 CALL para_env%sum(fodeb)
2041 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*Vxc(rho_admm)PAW", fodeb
2045 NULLIFY (rho_g_aux, rho_r_aux, tau_r_aux)
2046 CALL qs_rho_get(rho_aux_fit, rho_r=rho_r_aux, rho_g=rho_g_aux, tau_r=tau_r_aux)
2048 NULLIFY (rhoz_g_aux, rhoz_r_aux)
2049 ALLOCATE (rhoz_r_aux(nspins), rhoz_g_aux(nspins))
2050 DO ispin = 1, nspins
2051 CALL auxbas_pw_pool%create_pw(rhoz_r_aux(ispin))
2052 CALL auxbas_pw_pool%create_pw(rhoz_g_aux(ispin))
2054 DO ispin = 1, nspins
2056 rho=rhoz_r_aux(ispin), rho_gspace=rhoz_g_aux(ispin), &
2057 basis_type=basis_type, task_list_external=task_list)
2061 IF (use_virial)
THEN
2065 DO ispin = 1, nspins
2066 exc_aux_fit = exc_aux_fit + pw_integral_ab(rhoz_r_aux(ispin), vadmm_rspace(ispin))/ &
2067 vadmm_rspace(ispin)%pw_grid%dvol
2070 IF (debug_stress)
THEN
2071 stdeb = -1.0_dp*fconv*exc_aux_fit
2072 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T43,2(1X,ES19.11))") &
2080 IF (use_virial) virial%pv_xc = 0.0_dp
2086 rho1_r=rhoz_r_aux, &
2087 rho1_g=rhoz_g_aux, &
2089 xc_section=xc_section, &
2090 compute_virial=use_virial, &
2091 virial_xc=virial%pv_xc)
2094 IF (use_virial)
THEN
2095 virial%pv_exc = virial%pv_exc + virial%pv_xc
2096 virial%pv_virial = virial%pv_virial + virial%pv_xc
2099 IF (debug_stress .AND. use_virial)
THEN
2100 stdeb = 1.0_dp*fconv*virial%pv_xc
2101 CALL para_env%sum(stdeb)
2102 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2106 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=matrix_p)
2108 IF (use_virial)
THEN
2109 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
2111 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
2112 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
2113 DO ispin = 1, nspins
2114 CALL dbcsr_set(mhy(ispin, 1)%matrix, 0.0_dp)
2115 CALL pw_scale(v_xc(ispin), v_xc(ispin)%pw_grid%dvol)
2116 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=v_xc(ispin), &
2117 hmat=mhy(ispin, 1), pmat=matrix_p(ispin, 1), &
2118 calculate_forces=.true., &
2119 basis_type=basis_type, task_list_external=task_list)
2121 IF (debug_forces)
THEN
2122 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
2123 CALL para_env%sum(fodeb)
2124 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dK*rhoz_admm ", fodeb
2126 IF (debug_stress .AND. use_virial)
THEN
2127 stdeb = fconv*(virial%pv_virial - pv_loc)
2128 CALL para_env%sum(stdeb)
2129 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2133 IF (use_virial)
THEN
2134 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
2136 DO ispin = 1, nspins
2137 CALL auxbas_pw_pool%give_back_pw(v_xc(ispin))
2138 CALL auxbas_pw_pool%give_back_pw(rhoz_r_aux(ispin))
2139 CALL auxbas_pw_pool%give_back_pw(rhoz_g_aux(ispin))
2141 DEALLOCATE (v_xc, rhoz_r_aux, rhoz_g_aux)
2143 IF (admm_env%do_gapw)
THEN
2146 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
2148 admm_env%admm_gapw_env%admm_kind_set, &
2149 admm_env%admm_gapw_env%oce, sab_aux_fit, para_env)
2151 do_rho0=.false., kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
2154 local_rhoz_set_admm%rho_atom_set, &
2155 qs_env, xc_section, para_env, do_tddft=.false., do_triplet=.false., &
2156 kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
2158 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
2159 CALL update_ks_atom(qs_env, mhy(:, 1), matrix_p(:, 1), forces=.true., tddft=.false., &
2160 rho_atom_external=local_rhoz_set_admm%rho_atom_set, &
2161 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
2162 oce_external=admm_env%admm_gapw_env%oce, &
2163 sab_external=sab_aux_fit)
2164 IF (debug_forces)
THEN
2165 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
2166 CALL para_env%sum(fodeb)
2167 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dK*rhoz_admm[PAW] ", fodeb
2172 nao = admm_env%nao_orb
2173 nao_aux = admm_env%nao_aux_fit
2175 CALL dbcsr_create(dbwork, template=matrix_hz(1)%matrix)
2176 DO ispin = 1, nspins
2178 admm_env%work_aux_orb, nao)
2179 CALL parallel_gemm(
'T',
'N', nao, nao, nao_aux, &
2180 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
2181 admm_env%work_orb_orb)
2182 CALL dbcsr_copy(dbwork, matrix_hz(ispin)%matrix)
2183 CALL dbcsr_set(dbwork, 0.0_dp)
2185 CALL dbcsr_add(matrix_hz(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
2187 CALL dbcsr_release(dbwork)
2202 cpassert(n_rep_hf == 1)
2206 IF (hfx_treat_lsd_in_core) mspin = nspins
2207 IF (use_virial) virial%pv_fock_4c = 0.0_dp
2209 CALL get_qs_env(qs_env=qs_env, rho=rho, x_data=x_data, &
2210 s_mstruct_changed=s_mstruct_changed)
2211 distribute_fock_matrix = .true.
2216 IF (dft_control%do_admm)
THEN
2217 CALL get_qs_env(qs_env=qs_env, admm_env=admm_env)
2218 CALL get_admm_env(admm_env, matrix_s_aux_fit=scrm, rho_aux_fit=rho_aux_fit)
2219 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=matrix_p)
2220 NULLIFY (mpz, mhz, mpd, mhd)
2225 DO ispin = 1, nspins
2226 ALLOCATE (mhz(ispin, 1)%matrix, mhd(ispin, 1)%matrix)
2227 CALL dbcsr_create(mhz(ispin, 1)%matrix, template=scrm(1)%matrix)
2228 CALL dbcsr_create(mhd(ispin, 1)%matrix, template=scrm(1)%matrix)
2229 CALL dbcsr_copy(mhz(ispin, 1)%matrix, scrm(1)%matrix)
2230 CALL dbcsr_copy(mhd(ispin, 1)%matrix, scrm(1)%matrix)
2231 CALL dbcsr_set(mhz(ispin, 1)%matrix, 0.0_dp)
2232 CALL dbcsr_set(mhd(ispin, 1)%matrix, 0.0_dp)
2233 ALLOCATE (mpz(ispin, 1)%matrix)
2235 CALL dbcsr_create(mpz(ispin, 1)%matrix, template=scrm(1)%matrix)
2236 CALL dbcsr_copy(mpz(ispin, 1)%matrix, p_env%p1_admm(ispin)%matrix)
2237 CALL dbcsr_add(mpz(ispin, 1)%matrix, ex_env%matrix_pe_admm(ispin)%matrix, &
2240 CALL dbcsr_create(mpz(ispin, 1)%matrix, template=scrm(1)%matrix)
2241 CALL dbcsr_copy(mpz(ispin, 1)%matrix, matrix_pz_admm(ispin)%matrix)
2243 mpd(ispin, 1)%matrix => matrix_p(ispin, 1)%matrix
2246 IF (x_data(1, 1)%do_hfx_ri)
THEN
2249 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhz, eh1, rho_ao=mpz, &
2250 geometry_did_change=s_mstruct_changed, nspins=nspins, &
2251 hf_fraction=x_data(1, 1)%general_parameter%fraction)
2254 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhd, eh1, rho_ao=mpd, &
2255 geometry_did_change=s_mstruct_changed, nspins=nspins, &
2256 hf_fraction=x_data(1, 1)%general_parameter%fraction)
2262 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
2268 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
2274 cpassert(
ASSOCIATED(admm_env%work_aux_orb))
2275 cpassert(
ASSOCIATED(admm_env%work_orb_orb))
2276 nao = admm_env%nao_orb
2277 nao_aux = admm_env%nao_aux_fit
2279 CALL dbcsr_create(dbwork, template=matrix_hz(1)%matrix)
2280 DO ispin = 1, nspins
2282 admm_env%work_aux_orb, nao)
2283 CALL parallel_gemm(
'T',
'N', nao, nao, nao_aux, &
2284 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
2285 admm_env%work_orb_orb)
2286 CALL dbcsr_copy(dbwork, matrix_hz(ispin)%matrix)
2287 CALL dbcsr_set(dbwork, 0.0_dp)
2289 CALL dbcsr_add(matrix_hz(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
2291 CALL dbcsr_release(dbwork)
2294 IF (debug_forces) fodeb(1:3) = force(1)%overlap_admm(1:3, 1)
2295 IF (
ASSOCIATED(mhx) .AND.
ASSOCIATED(mhy))
THEN
2296 DO ispin = 1, nspins
2297 CALL dbcsr_add(mhd(ispin, 1)%matrix, mhx(ispin, 1)%matrix, 1.0_dp, 1.0_dp)
2298 CALL dbcsr_add(mhz(ispin, 1)%matrix, mhy(ispin, 1)%matrix, 1.0_dp, 1.0_dp)
2304 IF (debug_forces)
THEN
2305 fodeb(1:3) = force(1)%overlap_admm(1:3, 1) - fodeb(1:3)
2306 CALL para_env%sum(fodeb)
2307 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*hfx*S' ", fodeb
2312 IF (
ASSOCIATED(mhx) .AND.
ASSOCIATED(mhy))
THEN
2321 ALLOCATE (mpz(nspins, 1), mhz(nspins, 1))
2322 DO ispin = 1, nspins
2323 mhz(ispin, 1)%matrix => matrix_hz(ispin)%matrix
2324 mpz(ispin, 1)%matrix => mpa(ispin)%matrix
2327 IF (x_data(1, 1)%do_hfx_ri)
THEN
2330 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhz, eh1, rho_ao=mpz, &
2331 geometry_did_change=s_mstruct_changed, nspins=nspins, &
2332 hf_fraction=x_data(1, 1)%general_parameter%fraction)
2337 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
2341 DEALLOCATE (mhz, mpz)
2349 IF (debug_forces) fodeb(1:3) = force(1)%fock_4c(1:3, 1)
2350 IF (dft_control%do_admm)
THEN
2354 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=matrix_p)
2355 NULLIFY (matrix_pza)
2357 DO ispin = 1, nspins
2358 ALLOCATE (matrix_pza(ispin)%matrix)
2360 CALL dbcsr_create(matrix_pza(ispin)%matrix, template=p_env%p1_admm(ispin)%matrix)
2361 CALL dbcsr_copy(matrix_pza(ispin)%matrix, p_env%p1_admm(ispin)%matrix)
2362 CALL dbcsr_add(matrix_pza(ispin)%matrix, ex_env%matrix_pe_admm(ispin)%matrix, &
2365 CALL dbcsr_create(matrix_pza(ispin)%matrix, template=matrix_pz_admm(ispin)%matrix)
2366 CALL dbcsr_copy(matrix_pza(ispin)%matrix, matrix_pz_admm(ispin)%matrix)
2369 IF (x_data(1, 1)%do_hfx_ri)
THEN
2372 x_data(1, 1)%general_parameter%fraction, &
2373 rho_ao=matrix_p, rho_ao_resp=matrix_pza, &
2374 use_virial=use_virial, resp_only=resp_only)
2377 1, use_virial, resp_only=resp_only)
2385 IF (x_data(1, 1)%do_hfx_ri)
THEN
2388 x_data(1, 1)%general_parameter%fraction, &
2389 rho_ao=matrix_p, rho_ao_resp=mpa, &
2390 use_virial=use_virial, resp_only=resp_only)
2393 1, use_virial, resp_only=resp_only)
2397 IF (use_virial)
THEN
2398 virial%pv_exx = virial%pv_exx - virial%pv_fock_4c
2399 virial%pv_virial = virial%pv_virial - virial%pv_fock_4c
2400 virial%pv_calculate = .false.
2403 IF (debug_forces)
THEN
2404 fodeb(1:3) = force(1)%fock_4c(1:3, 1) - fodeb(1:3)
2405 CALL para_env%sum(fodeb)
2406 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*hfx ", fodeb
2408 IF (debug_stress .AND. use_virial)
THEN
2409 stdeb = -1.0_dp*fconv*virial%pv_fock_4c
2410 CALL para_env%sum(stdeb)
2411 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2418 IF (use_virial)
THEN
2420 zehartree = zehartree + 2.0_dp*ehartree
2423 IF (dft_control%do_admm)
THEN
2424 zexc_aux_fit = zexc_aux_fit + exc_aux_fit
2431 IF (dft_control%qs_control%do_ls_scf)
THEN
2433 eps_filter = dft_control%qs_control%eps_filter_matrix
2434 CALL calculate_whz_ao_matrix(qs_env, matrix_hz, matrix_wz, eps_filter)
2437 matrix_wz => p_env%w1
2440 IF (nspins == 1) focc = 2.0_dp
2442 DO ispin = 1, nspins
2443 CALL get_mo_set(mo_set=mos(ispin), homo=nocc)
2445 matrix_wz(ispin)%matrix, focc, nocc)
2448 IF (nspins == 2)
THEN
2449 CALL dbcsr_add(matrix_wz(1)%matrix, matrix_wz(2)%matrix, &
2450 alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
2453 IF (debug_forces) fodeb(1:3) = force(1)%overlap(1:3, 1)
2454 IF (debug_stress .AND. use_virial) stdeb = virial%pv_overlap
2457 matrix_name=
"OVERLAP MATRIX", &
2458 basis_type_a=
"ORB", basis_type_b=
"ORB", &
2459 sab_nl=sab_orb, calculate_forces=.true., &
2460 matrix_p=matrix_wz(1)%matrix)
2462 IF (
SIZE(matrix_wz, 1) == 2)
THEN
2463 CALL dbcsr_add(matrix_wz(1)%matrix, matrix_wz(2)%matrix, &
2464 alpha_scalar=1.0_dp, beta_scalar=-1.0_dp)
2467 IF (debug_forces)
THEN
2468 fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
2469 CALL para_env%sum(fodeb)
2470 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Wz*dS ", fodeb
2472 IF (debug_stress .AND. use_virial)
THEN
2473 stdeb = fconv*(virial%pv_overlap - stdeb)
2474 CALL para_env%sum(stdeb)
2475 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2480 IF (debug_forces)
THEN
2482 fodeb(1:3) = ftot2(1:3, 1) - ftot1(1:3, 1)
2483 CALL para_env%sum(fodeb)
2484 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Response Force", fodeb
2485 fodeb(1:3) = ftot2(1:3, 1)
2486 CALL para_env%sum(fodeb)
2487 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Total Force ", fodeb
2488 DEALLOCATE (ftot1, ftot2, ftot3)
2496 CALL timestop(handle)
2509 TYPE(qs_environment_type),
POINTER :: qs_env
2510 TYPE(qs_p_env_type) :: p_env
2511 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_hz
2512 TYPE(excited_energy_type),
OPTIONAL,
POINTER :: ex_env
2513 LOGICAL,
INTENT(IN),
OPTIONAL :: debug
2515 CHARACTER(LEN=*),
PARAMETER :: routinen =
'response_force_xtb'
2517 INTEGER :: atom_a, handle, iatom, ikind, iounit, &
2518 is, ispin, na, natom, natorb, nimages, &
2519 nkind, nocc, ns, nsgf, nspins
2520 INTEGER,
DIMENSION(25) :: lao
2521 INTEGER,
DIMENSION(5) :: occ
2522 LOGICAL :: debug_forces, do_ex, use_virial
2523 REAL(kind=dp) :: focc
2524 REAL(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: mcharge, mcharge1
2525 REAL(kind=dp),
ALLOCATABLE,
DIMENSION(:, :) :: aocg, aocg1, charges, charges1, ftot1, &
2527 REAL(kind=dp),
DIMENSION(3) :: fodeb
2528 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
2529 TYPE(cp_logger_type),
POINTER :: logger
2530 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_pz, matrix_wz, mpa, p_matrix, scrm
2531 TYPE(dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_p, matrix_s
2532 TYPE(dbcsr_type),
POINTER :: s_matrix
2533 TYPE(dft_control_type),
POINTER :: dft_control
2534 TYPE(mo_set_type),
DIMENSION(:),
POINTER :: mos
2535 TYPE(mp_para_env_type),
POINTER :: para_env
2536 TYPE(neighbor_list_set_p_type),
DIMENSION(:), &
2538 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
2539 TYPE(qs_force_type),
DIMENSION(:),
POINTER :: force
2540 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
2541 TYPE(qs_ks_env_type),
POINTER :: ks_env
2542 TYPE(qs_rho_type),
POINTER :: rho
2543 TYPE(xtb_atom_type),
POINTER :: xtb_kind
2545 CALL timeset(routinen, handle)
2547 IF (
PRESENT(debug))
THEN
2548 debug_forces = debug
2550 debug_forces = .false.
2553 logger => cp_get_default_logger()
2554 IF (logger%para_env%is_source())
THEN
2555 iounit = cp_logger_get_default_unit_nr(logger, local=.true.)
2561 IF (
PRESENT(ex_env)) do_ex = .true.
2563 NULLIFY (ks_env, sab_orb)
2564 CALL get_qs_env(qs_env=qs_env, ks_env=ks_env, dft_control=dft_control, &
2566 CALL get_qs_env(qs_env=qs_env, para_env=para_env, force=force)
2567 nspins = dft_control%nspins
2569 IF (debug_forces)
THEN
2570 CALL get_qs_env(qs_env, natom=natom, atomic_kind_set=atomic_kind_set)
2571 ALLOCATE (ftot1(3, natom))
2572 ALLOCATE (ftot2(3, natom))
2573 CALL total_qs_force(ftot1, force, atomic_kind_set)
2576 matrix_pz => p_env%p1
2579 CALL dbcsr_allocate_matrix_set(mpa, nspins)
2580 DO ispin = 1, nspins
2581 ALLOCATE (mpa(ispin)%matrix)
2582 CALL dbcsr_create(mpa(ispin)%matrix, template=matrix_pz(ispin)%matrix)
2583 CALL dbcsr_copy(mpa(ispin)%matrix, matrix_pz(ispin)%matrix)
2584 CALL dbcsr_add(mpa(ispin)%matrix, ex_env%matrix_pe(ispin)%matrix, 1.0_dp, 1.0_dp)
2585 CALL dbcsr_set(matrix_hz(ispin)%matrix, 0.0_dp)
2593 IF (nspins == 2)
THEN
2594 CALL dbcsr_add(mpa(1)%matrix, mpa(2)%matrix, 1.0_dp, 1.0_dp)
2597 IF (debug_forces) fodeb(1:3) = force(1)%all_potential(1:3, 1)
2598 CALL xtb_hab_force(qs_env, mpa(1)%matrix)
2599 IF (debug_forces)
THEN
2600 fodeb(1:3) = force(1)%all_potential(1:3, 1) - fodeb(1:3)
2601 CALL para_env%sum(fodeb)
2602 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dHcore ", fodeb
2604 IF (nspins == 2)
THEN
2605 CALL dbcsr_add(mpa(1)%matrix, mpa(2)%matrix, 1.0_dp, -1.0_dp)
2610 use_virial = .false.
2615 IF (dft_control%qs_control%xtb_control%coulomb_interaction)
THEN
2617 CALL get_qs_env(qs_env, rho=rho, particle_set=particle_set, matrix_s_kp=matrix_s)
2618 natom =
SIZE(particle_set)
2619 CALL qs_rho_get(rho, rho_ao_kp=matrix_p)
2620 ALLOCATE (mcharge(natom), charges(natom, 5))
2621 ALLOCATE (mcharge1(natom), charges1(natom, 5))
2624 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set)
2625 nkind =
SIZE(atomic_kind_set)
2626 CALL get_qs_kind_set(qs_kind_set, maxsgf=nsgf)
2627 ALLOCATE (aocg(nsgf, natom))
2629 ALLOCATE (aocg1(nsgf, natom))
2631 p_matrix => matrix_p(:, 1)
2632 s_matrix => matrix_s(1, 1)%matrix
2633 CALL ao_charges(p_matrix, s_matrix, aocg, para_env)
2634 CALL ao_charges(mpa, s_matrix, aocg1, para_env)
2636 CALL get_atomic_kind(atomic_kind_set(ikind), natom=na)
2637 CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_kind)
2638 CALL get_xtb_atom_param(xtb_kind, natorb=natorb, lao=lao, occupation=occ)
2640 atom_a = atomic_kind_set(ikind)%atom_list(iatom)
2641 charges(atom_a, :) = real(occ(:), kind=dp)
2644 charges(atom_a, ns) = charges(atom_a, ns) - aocg(is, atom_a)
2645 charges1(atom_a, ns) = charges1(atom_a, ns) - aocg1(is, atom_a)
2649 DEALLOCATE (aocg, aocg1)
2651 mcharge(iatom) = sum(charges(iatom, :))
2652 mcharge1(iatom) = sum(charges1(iatom, :))
2655 CALL xtb_coulomb_hessian(qs_env, matrix_hz, charges1, mcharge1, mcharge)
2656 CALL calc_xtb_ehess_force(qs_env, p_matrix, mpa, charges, mcharge, charges1, &
2657 mcharge1, debug_forces)
2659 DEALLOCATE (charges, mcharge, charges1, mcharge1)
2663 matrix_wz => p_env%w1
2665 IF (nspins == 1) focc = 1.0_dp
2666 CALL get_qs_env(qs_env, mos=mos)
2667 DO ispin = 1, nspins
2668 CALL get_mo_set(mo_set=mos(ispin), homo=nocc)
2669 CALL calculate_whz_matrix(mos(ispin)%mo_coeff, matrix_hz(ispin)%matrix, &
2670 matrix_wz(ispin)%matrix, focc, nocc)
2672 IF (nspins == 2)
THEN
2673 CALL dbcsr_add(matrix_wz(1)%matrix, matrix_wz(2)%matrix, &
2674 alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
2676 IF (debug_forces) fodeb(1:3) = force(1)%overlap(1:3, 1)
2678 CALL build_overlap_matrix(ks_env, matrix_s=scrm, &
2679 matrix_name=
"OVERLAP MATRIX", &
2680 basis_type_a=
"ORB", basis_type_b=
"ORB", &
2681 sab_nl=sab_orb, calculate_forces=.true., &
2682 matrix_p=matrix_wz(1)%matrix)
2683 IF (debug_forces)
THEN
2684 fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
2685 CALL para_env%sum(fodeb)
2686 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Wz*dS ", fodeb
2688 CALL dbcsr_deallocate_matrix_set(scrm)
2690 IF (debug_forces)
THEN
2691 CALL total_qs_force(ftot2, force, atomic_kind_set)
2692 fodeb(1:3) = ftot2(1:3, 1) - ftot1(1:3, 1)
2693 CALL para_env%sum(fodeb)
2694 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T30,3F16.8)")
"DEBUG:: Response Force", fodeb
2695 DEALLOCATE (ftot1, ftot2)
2699 CALL dbcsr_deallocate_matrix_set(mpa)
2702 CALL timestop(handle)
2719 SUBROUTINE calculate_whz_ao_matrix(qs_env, matrix_hz, matrix_whz, eps_filter)
2721 TYPE(qs_environment_type),
POINTER :: qs_env
2722 TYPE(dbcsr_p_type),
DIMENSION(:),
INTENT(IN), &
2723 POINTER :: matrix_hz
2724 TYPE(dbcsr_p_type),
DIMENSION(:),
INTENT(INOUT), &
2725 POINTER :: matrix_whz
2726 REAL(kind=dp),
INTENT(IN) :: eps_filter
2728 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_whz_ao_matrix'
2730 INTEGER :: handle, ispin, nspins
2731 REAL(kind=dp) :: scaling
2732 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: rho_ao
2733 TYPE(dbcsr_type) :: matrix_tmp
2734 TYPE(dft_control_type),
POINTER :: dft_control
2735 TYPE(mp_para_env_type),
POINTER :: para_env
2736 TYPE(qs_rho_type),
POINTER :: rho
2738 CALL timeset(routinen, handle)
2740 cpassert(
ASSOCIATED(qs_env))
2741 cpassert(
ASSOCIATED(matrix_hz))
2742 cpassert(
ASSOCIATED(matrix_whz))
2744 CALL get_qs_env(qs_env=qs_env, &
2745 dft_control=dft_control, &
2748 nspins = dft_control%nspins
2749 CALL qs_rho_get(rho, rho_ao=rho_ao)
2752 CALL dbcsr_create(matrix_tmp, template=matrix_hz(1)%matrix, &
2753 matrix_type=dbcsr_type_no_symmetry)
2757 IF (nspins == 1) scaling = 0.5_dp
2772 IF (nspins == 1) scaling = 0.5_dp
2774 DO ispin = 1, nspins
2777 CALL dbcsr_multiply(
"N",
"N", scaling, matrix_hz(ispin)%matrix, rho_ao(ispin)%matrix, &
2778 0.0_dp, matrix_tmp, filter_eps=eps_filter)
2782 CALL dbcsr_multiply(
"N",
"N", 1.0_dp, rho_ao(ispin)%matrix, matrix_tmp, &
2783 1.0_dp, matrix_whz(ispin)%matrix, filter_eps=eps_filter, &
2784 retain_sparsity=.true.)
2788 CALL dbcsr_release(matrix_tmp)
2790 CALL timestop(handle)
real(kind=dp) function det_3x3(a)
...
Contains ADMM methods which require molecular orbitals.
subroutine, public admm_projection_derivative(qs_env, matrix_hz, matrix_pz, fval)
Calculate derivatives terms from overlap matrices.
Types and set/get functions for auxiliary density matrix methods.
subroutine, public get_admm_env(admm_env, mo_derivs_aux_fit, mos_aux_fit, sab_aux_fit, sab_aux_fit_asymm, sab_aux_fit_vs_orb, matrix_s_aux_fit, matrix_s_aux_fit_kp, matrix_s_aux_fit_vs_orb, matrix_s_aux_fit_vs_orb_kp, task_list_aux_fit, matrix_ks_aux_fit, matrix_ks_aux_fit_kp, matrix_ks_aux_fit_im, matrix_ks_aux_fit_dft, matrix_ks_aux_fit_hfx, matrix_ks_aux_fit_dft_kp, matrix_ks_aux_fit_hfx_kp, rho_aux_fit, rho_aux_fit_buffer, admm_dm)
Get routine for the ADMM env.
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
Handles all functions related to the CELL.
Calculation of the nuclear attraction contribution to the core Hamiltonian <a|erfc|b> :we only calcul...
subroutine, public build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, use_virial, nder, qs_kind_set, atomic_kind_set, particle_set, sab_orb, sac_ae, nimages, cell_to_index)
...
Calculation of the local pseudopotential contribution to the core Hamiltonian <a|V(local)|b> = <a|Sum...
subroutine, public build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, use_virial, nder, qs_kind_set, atomic_kind_set, particle_set, sab_orb, sac_ppl, nimages, cell_to_index, basis_type, deltaR)
...
Calculation of the non-local pseudopotential contribution to the core Hamiltonian <a|V(non-local)|b> ...
subroutine, public build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, use_virial, nder, qs_kind_set, atomic_kind_set, particle_set, sab_orb, sap_ppnl, eps_ppnl, nimages, cell_to_index, basis_type, deltaR, matrix_l)
...
methods related to the blacs parallel environment
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Routines that link DBCSR and CP2K concepts together.
subroutine, public cp_dbcsr_alloc_block_from_nbl(matrix, sab_orb, desymmetrize)
allocate the blocks of a dbcsr based on the neighbor list
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
represent the structure of a full matrix
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_init_random(matrix, ncol, start_col)
fills a matrix with random numbers
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
various routines to log and control the output. The idea is that decisions about where to log should ...
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Types needed for a for a Energy Correction.
Routines used for Harris functional Kohn-Sham calculation.
subroutine, public ec_mos_init(qs_env, matrix_s)
Allocate and initiate molecular orbitals environment.
subroutine, public create_kernel(qs_env, vxc, vxc_tau, rho, rho1_r, rho1_g, tau1_r, xc_section, compute_virial, virial_xc)
Creation of second derivative xc-potential.
AO-based conjugate-gradient response solver routines.
subroutine, public ec_response_ao(qs_env, p_env, matrix_hz, matrix_pz, matrix_wz, iounit, should_stop)
AO-based conjugate gradient linear response solver. In goes the right hand side B of the equation AZ=...
Types for excited states potential energies.
subroutine, public init_coulomb_local(hartree_local, natom)
...
subroutine, public vh_1c_gg_integrals(qs_env, energy_hartree_1c, ecoul_1c, local_rho_set, para_env, tddft, local_rho_set_2nd, core_2nd)
Calculates one center GAPW Hartree energies and matrix elements Hartree potentials are input Takes po...
subroutine, public hartree_local_release(hartree_local)
...
subroutine, public hartree_local_create(hartree_local)
...
Routines to calculate derivatives with respect to basis function origin.
subroutine, public derivatives_four_center(qs_env, rho_ao, rho_ao_resp, hfx_section, para_env, irep, use_virial, adiabatic_rescale_factor, resp_only, external_x_data)
computes four center derivatives for a full basis set and updates the forcesfock_4c arrays....
Routines to calculate HFX energy and potential.
subroutine, public integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_section, para_env, geometry_did_change, irep, distribute_fock_matrix, ispin)
computes four center integrals for a full basis set and updates the Kohn-Sham-Matrix and energy....
subroutine, public hfx_ri_update_ks(qs_env, ri_data, ks_matrix, ehfx, mos, rho_ao, geometry_did_change, nspins, hf_fraction)
...
subroutine, public hfx_ri_update_forces(qs_env, ri_data, nspins, hf_fraction, rho_ao, rho_ao_resp, mos, use_virial, resp_only, rescale_factor)
the general routine that calls the relevant force code
Types and set/get functions for HFX.
Routines for a Kim-Gordon-like partitioning into molecular subunits.
subroutine, public kg_ekin_subset(qs_env, ks_matrix, ekin_mol, calc_force, do_kernel, pmat_ext)
Calculates the subsystem Hohenberg-Kohn kinetic energy and the forces.
Types needed for a Kim-Gordon-like partitioning into molecular subunits.
Calculation of the local potential contribution of the nonadditive kinetic energy <a|V(local)|b> = <a...
subroutine, public build_tnadd_mat(kg_env, matrix_p, force, virial, calculate_forces, use_virial, qs_kind_set, atomic_kind_set, particle_set, sab_orb, dbcsr_dist)
...
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
Machine interface based on Fortran 2003 and POSIX.
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Collection of simple mathematical functions and subroutines.
Interface to the message passing library MPI.
compute mulliken charges we (currently) define them as c_i = 1/2 [ (PS)_{ii} + (SP)_{ii} ]
basic linear algebra operations for full matrixes
Define the data structure for the particle information.
Definition of physical constants:
real(kind=dp), parameter, public pascal
container for various plainwaves related things
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
functions related to the poisson solver on regular grids
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Routines to calculate 2nd order kernels from a given response density in ao basis linear response scf...
subroutine, public build_dm_response(c0, c1, dm)
This routine builds response density in dbcsr format.
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
subroutine, public calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, ks_env, soft_valid, compute_tau, compute_grad, basis_type, der_type, idir, task_list_external, pw_env_external)
computes the density corresponding to a given density matrix on the grid
collects routines that calculate density matrices
subroutine, public calculate_whz_matrix(c0vec, hzm, w_matrix, focc, nocc)
Calculate the Wz matrix from the MO eigenvectors, MO eigenvalues, and the MO occupation numbers....
subroutine, public calculate_wz_matrix(mo_set, psi1, ks_matrix, w_matrix)
Calculate the response W matrix from the MO eigenvectors, MO eigenvalues, and the MO occupation numbe...
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_RI_aux_kp, matrix_s, matrix_s_RI_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, ecoul_1c, rho0_s_rs, rho0_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, 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, lri_env, lri_density, exstate_env, ec_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_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)
Get the QUICKSTEP environment.
subroutine, public set_qs_env(qs_env, super_cell, mos, qmmm, qmmm_periodic, ewald_env, ewald_pw, mpools, rho_external, external_vxc, mask, scf_control, rel_control, qs_charges, ks_env, ks_qmmm_env, wf_history, scf_env, active_space, input, oce, rho_atom_set, rho0_atom_set, rho0_mpole, run_rtp, rtp, rhoz_set, rhoz_tot, ecoul_1c, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, efield, 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, exstate_env, ec_env, dispersion_env, gcp_env, mp2_env, bs_env, kg_env, force, kpoints, WannierCentres, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, rhs)
Set the QUICKSTEP environment.
subroutine, public total_qs_force(force, qs_force, atomic_kind_set)
Get current total force.
subroutine, public prepare_gapw_den(qs_env, local_rho_set, do_rho0, kind_set_external)
...
Integrate single or product functions over a potential on a RS grid.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_r3d_rs_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, U_of_dft_plus_u, J_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, J0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, floating, name, element_symbol, pao_basis_size, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
subroutine, public get_qs_kind_set(qs_kind_set, all_potential_present, tnadd_potential_present, gth_potential_present, sgp_potential_present, paw_atom_present, dft_plus_u_atom_present, maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, maxlprj, maxnset, maxsgf_set, ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, maxppnl, nelectron, maxder, max_ngrid_rad, max_sph_harm, maxg_iso_not0, lmax_rho0, basis_rcut, basis_type, total_zeff_corr)
Get attributes of an atomic kind set.
Calculation of kinetic energy matrix and forces.
subroutine, public build_kinetic_matrix(ks_env, matrix_t, matrixkp_t, matrix_name, basis_type, sab_nl, calculate_forces, matrix_p, matrixkp_p, eps_filter, nderivative)
Calculation of the kinetic energy matrix over Cartesian Gaussian functions.
routines that build the Kohn-Sham matrix contributions coming from local atomic densities
subroutine, public update_ks_atom(qs_env, ksmat, pmat, forces, tddft, rho_atom_external, kind_set_external, oce_external, sab_external, kscale, kintegral, kforce, fscale)
The correction to the KS matrix due to the GAPW local terms to the hartree and XC contributions is he...
routines that build the Kohn-Sham matrix (i.e calculate the coulomb and xc parts
subroutine, public calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho, skip_nuclear_density)
...
localize wavefunctions linear response scf
subroutine, public linres_solver(p_env, qs_env, psi1, h1_psi0, psi0_order, iounit, should_stop)
scf loop to optimize the first order wavefunctions (psi1) given a perturbation as an operator applied...
Type definitiona for linear response calculations.
subroutine, public local_rho_set_create(local_rho_set)
...
subroutine, public local_rho_set_release(local_rho_set)
...
wrapper for the pools of matrixes
subroutine, public mpools_rebuild_fm_pools(mpools, mos, blacs_env, para_env, nmosub)
rebuilds the pools of the (ao x mo, ao x ao , mo x mo) full matrixes
collects routines that perform operations directly related to MOs
subroutine, public make_basis_sm(vmatrix, ncol, matrix_s)
returns an S-orthonormal basis v (v^T S v ==1)
Definition and initialisation of the mo data type.
subroutine, public deallocate_mo_set(mo_set)
Deallocate a wavefunction data structure.
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kTS, mu, flexible_electron_count)
Get the components of a MO set data structure.
Define the neighbor list data types and the corresponding functionality.
Calculation of overlap matrix, its derivatives and forces.
subroutine, public build_overlap_matrix(ks_env, matrix_s, matrixkp_s, matrix_name, nderivative, basis_type_a, basis_type_b, sab_nl, calculate_forces, matrix_p, matrixkp_p)
Calculation of the overlap matrix over Cartesian Gaussian functions.
Utility functions for the perturbation calculations.
subroutine, public p_env_psi0_changed(p_env, qs_env)
To be called after the value of psi0 has changed. Recalculates the quantities S_psi0 and m_epsilon.
subroutine, public p_env_create(p_env, qs_env, p1_option, p1_admm_option, orthogonal_orbitals, linres_control)
allocates and initializes the perturbation environment (no setup)
basis types for the calculation of the perturbation of density theory.
subroutine, public p_env_release(p_env)
relases the given p_env (see doc/ReferenceCounting.html)
subroutine, public integrate_vhg0_rspace(qs_env, v_rspace, para_env, calculate_forces, local_rho_set, local_rho_set_2nd, atener, kforce)
...
subroutine, public rho0_s_grid_create(pw_env, rho0_mpole)
...
subroutine, public init_rho0(local_rho_set, qs_env, gapw_control, zcore)
...
subroutine, public allocate_rho_atom_internals(rho_atom_set, atomic_kind_set, qs_kind_set, dft_control, para_env)
...
subroutine, public calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set, qs_kind_set, oce, sab, para_env)
...
superstucture that hold various representations of the density and keeps track of which ones are vali...
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
routines that build the integrals of the Vxc potential calculated for the atomic density in the basis...
subroutine, public calculate_xc_2nd_deriv_atom(rho_atom_set, rho1_atom_set, qs_env, xc_section, para_env, do_tddft, do_tddfpt2, do_triplet, kind_set_external)
...
subroutine, public calculate_vxc_atom(qs_env, energy_only, exc1, gradient_atom_set, adiabatic_rescale_factor, kind_set_external, rho_atom_set_external, xc_section_external)
...
Calculate the CPKS equation and the resulting forces.
subroutine, public response_equation_new(qs_env, p_env, cpmos, iounit)
Initializes vectors for MO-coefficient based linear response solver and calculates response density,...
subroutine, public response_force_xtb(qs_env, p_env, matrix_hz, ex_env, debug)
...
subroutine, public response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspace, matrix_hz, matrix_pz, matrix_pz_admm, matrix_wz, zehartree, zexc, zexc_aux_fit, rhopz_r, p_env, ex_env, debug)
...
subroutine, public response_equation(qs_env, p_env, cpmos, iounit, lr_section)
Initializes vectors for MO-coefficient based linear response solver and calculates response density,...
subroutine, public response_calculation(qs_env, ec_env)
Initializes solver of linear response equation for energy correction.
pure real(kind=dp) function, public one_third_sum_diag(a)
...
Calculation of forces for Coulomb contributions in response xTB.
subroutine, public calc_xtb_ehess_force(qs_env, matrix_p0, matrix_p1, charges0, mcharge0, charges1, mcharge1, debug_forces)
...
Calculation of Coulomb Hessian contributions in xTB.
subroutine, public xtb_coulomb_hessian(qs_env, ks_matrix, charges1, mcharge1, mcharge)
...
Calculation of Overlap and Hamiltonian matrices in xTB Reference: Stefan Grimme, Christoph Bannwarth,...
subroutine, public xtb_hab_force(qs_env, p_matrix)
...
Definition of the xTB parameter types.
subroutine, public get_xtb_atom_param(xtb_parameter, symbol, aname, typ, defined, z, zeff, natorb, lmax, nao, lao, rcut, rcov, kx, eta, xgamma, alpha, zneff, nshell, nval, lval, kpoly, kappa, hen, zeta, occupation, electronegativity, chmax)
...