58#include "./base/base_uses.f90"
63 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .false.
64 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'cp_ddapc_util'
82 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_ddapc_init'
84 INTEGER :: handle, i, iw, iw2, n_rep_val, num_gauss
85 LOGICAL :: allocate_ddapc_env, unimplemented
86 REAL(kind=
dp) :: gcut, pfact, rcmin, vol
87 REAL(kind=
dp),
DIMENSION(:),
POINTER :: inp_radii, radii
88 TYPE(
cell_type),
POINTER :: cell, super_cell
100 CALL timeset(routinen, handle)
102 NULLIFY (dft_control, rho, pw_env, &
103 radii, inp_radii, particle_set, qs_charges, para_env)
105 CALL get_qs_env(qs_env, dft_control=dft_control)
106 allocate_ddapc_env = qs_env%cp_ddapc_ewald%do_solvation .OR. &
107 qs_env%cp_ddapc_ewald%do_qmmm_periodic_decpl .OR. &
108 qs_env%cp_ddapc_ewald%do_decoupling .OR. &
109 qs_env%cp_ddapc_ewald%do_restraint
110 unimplemented = dft_control%qs_control%semi_empirical .OR. &
111 dft_control%qs_control%dftb .OR. &
112 dft_control%qs_control%xtb
113 IF (allocate_ddapc_env .AND. unimplemented)
THEN
114 cpabort(
"DDAP charges work only with GPW/GAPW code.")
116 allocate_ddapc_env = allocate_ddapc_env .OR. &
117 qs_env%cp_ddapc_ewald%do_property
118 allocate_ddapc_env = allocate_ddapc_env .AND. (.NOT. unimplemented)
119 IF (allocate_ddapc_env)
THEN
121 dft_control=dft_control, &
124 qs_charges=qs_charges, &
125 particle_set=particle_set, &
127 super_cell=super_cell, &
131 "PROGRAM_RUN_INFO",
".FitCharge")
133 WRITE (iw,
'(/,A)')
" Initializing the DDAPC Environment"
135 CALL pw_env_get(pw_env=pw_env, auxbas_pw_pool=auxbas_pool)
136 CALL auxbas_pool%create_pw(rho_tot_g)
137 vol = rho_tot_g%pw_grid%vol
142 IF (n_rep_val /= 0)
THEN
144 num_gauss =
SIZE(inp_radii)
145 ALLOCATE (radii(num_gauss))
151 ALLOCATE (radii(num_gauss))
153 radii(i) = rcmin*pfact**(i - 1)
159 "PROGRAM_RUN_INFO/CONDITION_NUMBER",
".FitCharge")
162 ALLOCATE (qs_env%cp_ddapc_env)
164 qs_env%cp_ddapc_env, &
165 qs_env%cp_ddapc_ewald, &
176 "PROGRAM_RUN_INFO/CONDITION_NUMBER")
178 CALL auxbas_pool%give_back_pw(rho_tot_g)
180 CALL timestop(handle)
200 RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, &
201 density_type, qout1, qout2, out_radii, dq_out, ext_rho_tot_g, &
202 Itype_of_density, iwc)
204 LOGICAL,
INTENT(in),
OPTIONAL :: calc_force
206 INTEGER,
OPTIONAL :: density_type
207 REAL(kind=
dp),
DIMENSION(:),
OPTIONAL,
POINTER :: qout1, qout2, out_radii
208 REAL(kind=
dp),
DIMENSION(:, :, :),
OPTIONAL, &
211 CHARACTER(LEN=*),
OPTIONAL :: itype_of_density
212 INTEGER,
INTENT(IN),
OPTIONAL :: iwc
214 CHARACTER(len=*),
PARAMETER :: routinen =
'get_ddapc'
216 CHARACTER(LEN=default_string_length) :: type_of_density
217 INTEGER :: handle, handle2, handle3, i, ii, &
218 iparticle, iparticle0, ispin, iw, j, &
219 myid, n_rep_val, ndim, nparticles, &
220 num_gauss, pmax, pmin
222 REAL(kind=
dp) :: c1, c3, ch_dens, gcut, pfact, rcmin, vol
223 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: ami_bv, ami_cv, bv, cv, cvt_ami, &
224 cvt_ami_damj, damj_qv, qtot, qv
225 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: dbv, g_dot_rvec_cos, g_dot_rvec_sin
226 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: dam, dqv, tv
227 REAL(kind=
dp),
DIMENSION(:),
POINTER :: inp_radii, radii
228 TYPE(
cell_type),
POINTER :: cell, super_cell
240 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
247 EXTERNAL dgemv,
dgemm
249 CALL timeset(routinen, handle)
251 IF (
PRESENT(calc_force)) need_f = calc_force
253 NULLIFY (dft_control, rho, rho_core, rho0_s_gs, pw_env, rho_g, rho_r, &
254 radii, inp_radii, particle_set, qs_kind_set, qs_charges, cp_ddapc_env)
256 dft_control=dft_control, &
259 rho0_s_gs=rho0_s_gs, &
261 qs_charges=qs_charges, &
262 particle_set=particle_set, &
263 qs_kind_set=qs_kind_set, &
265 super_cell=super_cell)
267 CALL qs_rho_get(rho, rho_r=rho_r, rho_g=rho_g)
269 IF (
PRESENT(iwc))
THEN
273 "PROGRAM_RUN_INFO",
".FitCharge")
276 auxbas_pw_pool=auxbas_pool)
277 CALL auxbas_pool%create_pw(rho_tot_g)
278 IF (
PRESENT(ext_rho_tot_g))
THEN
281 type_of_density = itype_of_density
283 IF (
PRESENT(density_type))
THEN
287 "PROPERTIES%FIT_CHARGE%TYPE_OF_DENSITY", i_val=myid)
292 IF (dft_control%qs_control%gapw)
THEN
297 DO ispin = 1,
SIZE(rho_g)
298 CALL pw_axpy(rho_g(ispin), rho_tot_g)
300 type_of_density =
"FULL DENSITY"
302 CALL pw_copy(rho_g(1), rho_tot_g)
303 CALL pw_axpy(rho_g(2), rho_tot_g, alpha=-1._dp)
304 type_of_density =
"SPIN DENSITY"
307 vol = rho_r(1)%pw_grid%vol
310 IF (rho_tot_g%pw_grid%have_g0) ch_dens = real(rho_tot_g%array(1), kind=
dp)
311 CALL logger%para_env%sum(ch_dens)
316 IF (n_rep_val /= 0)
THEN
318 num_gauss =
SIZE(inp_radii)
319 ALLOCATE (radii(num_gauss))
325 ALLOCATE (radii(num_gauss))
327 radii(i) = rcmin*pfact**(i - 1)
330 IF (
PRESENT(out_radii))
THEN
331 IF (
ASSOCIATED(out_radii))
THEN
332 DEALLOCATE (out_radii)
334 ALLOCATE (out_radii(
SIZE(radii)))
338 cp_ddapc_env => qs_env%cp_ddapc_env
342 ndim =
SIZE(particle_set)*
SIZE(radii)
345 ALLOCATE (qtot(
SIZE(particle_set)))
347 CALL timeset(routinen//
"-charges", handle2)
351 particle_set, radii, rho_tot_g, gcut); bv(:) = bv(:)/vol
352 CALL rho_tot_g%pw_grid%para%group%sum(bv)
353 c1 = dot_product(cv, matmul(cp_ddapc_env%AmI, bv)) - ch_dens
354 c1 = c1/cp_ddapc_env%c0
355 qv(:) = -matmul(cp_ddapc_env%AmI, (bv - c1*cv))
358 DO i = 1, ndim, num_gauss
361 qtot(j) = qtot(j) + qv((i - 1) + ii)
364 IF (
PRESENT(qout1))
THEN
365 IF (
ASSOCIATED(qout1))
THEN
366 cpassert(
SIZE(qout1) ==
SIZE(qv))
368 ALLOCATE (qout1(
SIZE(qv)))
372 IF (
PRESENT(qout2))
THEN
373 IF (
ASSOCIATED(qout2))
THEN
374 cpassert(
SIZE(qout2) ==
SIZE(qtot))
376 ALLOCATE (qout2(
SIZE(qtot)))
382 CALL timestop(handle2)
387 CALL timeset(routinen//
"-forces", handle3)
389 WRITE (iw,
'(T3,A)')
" Evaluating DDAPC atomic derivatives .."
391 ALLOCATE (dam(ndim, ndim, 3))
392 ALLOCATE (dbv(ndim, 3))
393 ALLOCATE (dqv(ndim,
SIZE(particle_set), 3))
395 ALLOCATE (cvt_ami(ndim))
396 ALLOCATE (cvt_ami_damj(ndim))
397 ALLOCATE (tv(ndim,
SIZE(particle_set), 3))
398 ALLOCATE (ami_cv(ndim))
399 cvt_ami(:) = matmul(cv, cp_ddapc_env%AmI)
400 ami_cv(:) = matmul(cp_ddapc_env%AmI, cv)
401 ALLOCATE (damj_qv(ndim))
402 ALLOCATE (ami_bv(ndim))
403 ami_bv(:) = matmul(cp_ddapc_env%AmI, bv)
410 DO iparticle0 = 1,
SIZE(particle_set), npset
411 nparticles = min(npset,
SIZE(particle_set) - iparticle0 + 1)
417 particle_set, radii, rho_tot_g, gcut, iparticle0, &
418 nparticles, g_dot_rvec_sin, g_dot_rvec_cos)
425 DO iparticle = iparticle0, iparticle0 + nparticles - 1
426 IF (debug_this_module)
THEN
427 CALL debug_der_a_matrix(dam, particle_set, radii, rho_tot_g, &
428 gcut, iparticle, vol, qs_env)
429 cp_ddapc_env => qs_env%cp_ddapc_env
433 particle_set, radii, rho_tot_g, gcut, iparticle)
434 dbv(:, :) = dbv(:, :)/vol
435 IF (debug_this_module)
THEN
436 CALL debug_der_b_vector(dbv, particle_set, radii, rho_tot_g, &
437 gcut, iparticle, vol, qs_env)
438 cp_ddapc_env => qs_env%cp_ddapc_env
442 pmin = (iparticle - 1)*
SIZE(radii) + 1
443 pmax = iparticle*
SIZE(radii)
447 damj_qv(:pmin - 1) = matmul(transpose(dam(pmin:pmax, :pmin - 1, j)), qv(pmin:pmax))
448 cvt_ami_damj(:pmin - 1) = matmul(transpose(dam(pmin:pmax, :pmin - 1, j)), cvt_ami(pmin:pmax))
451 damj_qv(pmin:pmax) = matmul(dam(pmin:pmax, :, j), qv(:))
452 cvt_ami_damj(pmin:pmax) = matmul(dam(pmin:pmax, :, j), cvt_ami(:))
455 IF (pmax <
SIZE(particle_set)*
SIZE(radii))
THEN
456 damj_qv(pmax + 1:) = matmul(transpose(dam(pmin:pmax, pmax + 1:, j)), qv(pmin:pmax))
457 cvt_ami_damj(pmax + 1:) = matmul(transpose(dam(pmin:pmax, pmax + 1:, j)), cvt_ami(pmin:pmax))
459 damj_qv(:) = damj_qv(:)/(vol*vol)
460 cvt_ami_damj(:) = cvt_ami_damj(:)/(vol*vol)
461 c3 = dot_product(cvt_ami_damj, ami_bv) - dot_product(cvt_ami, dbv(:, j)) - c1*dot_product(cvt_ami_damj, ami_cv)
462 tv(:, iparticle, j) = -(damj_qv(:) + dbv(:, j) + c3/cp_ddapc_env%c0*cv)
465 dam((iparticle - 1)*
SIZE(radii) + 1:iparticle*
SIZE(radii), :, :) = 0.0_dp
470 CALL dgemm(
'N',
'N',
SIZE(dqv, 1),
SIZE(dqv, 2)*
SIZE(dqv, 3),
SIZE(cp_ddapc_env%AmI, 2), 1.0_dp, &
471 cp_ddapc_env%AmI,
SIZE(cp_ddapc_env%AmI, 1), tv,
SIZE(tv, 1), 0.0_dp, dqv,
SIZE(dqv, 1))
477 cpassert(
PRESENT(dq_out))
478 IF (.NOT.
ASSOCIATED(dq_out))
THEN
479 ALLOCATE (dq_out(
SIZE(dqv, 1),
SIZE(dqv, 2),
SIZE(dqv, 3)))
481 cpassert(
SIZE(dqv, 1) ==
SIZE(dq_out, 1))
482 cpassert(
SIZE(dqv, 2) ==
SIZE(dq_out, 2))
483 cpassert(
SIZE(dqv, 3) ==
SIZE(dq_out, 3))
486 IF (debug_this_module)
THEN
487 CALL debug_charge(dqv, qs_env, density_fit_section, &
488 particle_set, radii, rho_tot_g, type_of_density)
489 cp_ddapc_env => qs_env%cp_ddapc_env
496 DEALLOCATE (cvt_ami_damj)
501 CALL timestop(handle3)
511 IF (.NOT.
PRESENT(iwc))
THEN
515 CALL auxbas_pool%give_back_pw(rho_tot_g)
516 CALL timestop(handle)
533 density_fit_section, particle_set, AmI, radii, charges, &
534 ddapc_restraint_control, energy_res)
538 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: ami
539 REAL(kind=
dp),
DIMENSION(:),
POINTER :: radii, charges
541 REAL(kind=
dp),
INTENT(INOUT) :: energy_res
543 CHARACTER(len=*),
PARAMETER :: routinen =
'restraint_functional_potential'
545 COMPLEX(KIND=dp) :: g_corr, phase
546 INTEGER :: handle, idim, ig, igauss, iparticle, &
548 REAL(kind=
dp) :: arg,
fac, fac2, g2, gcut, gcut2, gfunc, &
549 gvec(3), rc, rc2, rvec(3), sfac, vol, w
550 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: cv, uv
552 CALL timeset(routinen, handle)
553 n_gauss =
SIZE(radii)
554 ALLOCATE (cv(n_gauss*
SIZE(particle_set)))
555 ALLOCATE (uv(n_gauss*
SIZE(particle_set)))
562 associate(pw_grid => v_hartree_gspace%pw_grid)
566 fac = dot_product(cv, matmul(ami, cv))
567 fac2 = dot_product(cv, matmul(ami, uv))
568 cv(:) = uv - cv*fac2/
fac
569 cv(:) = matmul(ami, cv)
570 IF (pw_grid%have_g0) v_hartree_gspace%array(1) = v_hartree_gspace%array(1) + sfac*fac2/
fac
571 DO ig = pw_grid%first_gne0, pw_grid%ngpts_cut_local
573 w = 4.0_dp*
pi*(g2 - gcut2)**2.0_dp/(g2*gcut2)
575 gvec = pw_grid%g(:, ig)
578 DO iparticle = 1,
SIZE(particle_set)
579 DO igauss = 1,
SIZE(radii)
583 rvec = particle_set(iparticle)%r
584 arg = dot_product(gvec, rvec)
585 phase = cmplx(cos(arg), -sin(arg), kind=
dp)
586 gfunc = exp(-g2*rc2/4.0_dp)
587 g_corr = g_corr + gfunc*cv(idim)*phase
591 v_hartree_gspace%array(ig) = v_hartree_gspace%array(ig) + sfac*g_corr/vol
594 CALL timestop(handle)
611 particle_set, M, AmI, radii, charges)
612 TYPE(pw_c1d_gs_type),
INTENT(IN) :: v_hartree_gspace
613 TYPE(section_vals_type),
POINTER :: density_fit_section
614 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
615 REAL(kind=dp),
DIMENSION(:, :),
POINTER :: m, ami
616 REAL(kind=dp),
DIMENSION(:),
POINTER :: radii, charges
618 CHARACTER(len=*),
PARAMETER :: routinen =
'modify_hartree_pot'
620 COMPLEX(KIND=dp) :: g_corr, phase
621 INTEGER :: handle, idim, ig, igauss, iparticle
622 REAL(kind=dp) :: arg,
fac, fac2, g2, gcut, gcut2, gfunc, &
623 gvec(3), rc, rc2, rvec(3), sfac, vol, w
624 REAL(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: cv, uv
626 CALL timeset(routinen, handle)
627 CALL section_vals_val_get(density_fit_section,
"GCUT", r_val=gcut)
629 associate(pw_grid => v_hartree_gspace%pw_grid)
631 ALLOCATE (cv(
SIZE(m, 1)))
632 ALLOCATE (uv(
SIZE(m, 1)))
634 uv(:) = matmul(m, charges)
636 fac = dot_product(cv, matmul(ami, cv))
637 fac2 = dot_product(cv, matmul(ami, uv))
638 cv(:) = uv - cv*fac2/
fac
639 cv(:) = matmul(ami, cv)
640 IF (pw_grid%have_g0) v_hartree_gspace%array(1) = v_hartree_gspace%array(1) + sfac*fac2/
fac
641 DO ig = pw_grid%first_gne0, pw_grid%ngpts_cut_local
643 w = 4.0_dp*pi*(g2 - gcut2)**2.0_dp/(g2*gcut2)
645 gvec = pw_grid%g(:, ig)
648 DO iparticle = 1,
SIZE(particle_set)
649 DO igauss = 1,
SIZE(radii)
653 rvec = particle_set(iparticle)%r
654 arg = dot_product(gvec, rvec)
655 phase = cmplx(cos(arg), -sin(arg), kind=dp)
656 gfunc = exp(-g2*rc2/4.0_dp)
657 g_corr = g_corr + gfunc*cv(idim)*phase
661 v_hartree_gspace%array(ig) = v_hartree_gspace%array(ig) + sfac*g_corr/vol
664 CALL timestop(handle)
682 SUBROUTINE debug_der_b_vector(dbv, particle_set, radii, &
683 rho_tot_g, gcut, iparticle, Vol, qs_env)
684 REAL(kind=dp),
DIMENSION(:, :),
INTENT(IN) :: dbv
685 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
686 REAL(kind=dp),
DIMENSION(:),
POINTER :: radii
687 TYPE(pw_c1d_gs_type),
INTENT(IN) :: rho_tot_g
688 REAL(kind=dp),
INTENT(IN) :: gcut
689 INTEGER,
INTENT(in) :: iparticle
690 REAL(kind=dp),
INTENT(IN) :: vol
691 TYPE(qs_environment_type),
POINTER :: qs_env
693 CHARACTER(len=*),
PARAMETER :: routinen =
'debug_der_b_vector'
695 INTEGER :: handle, i, kk, ndim
696 REAL(kind=dp) :: dx, rvec(3), v0
697 REAL(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: bv1, bv2, ddbv
698 TYPE(cp_ddapc_type),
POINTER :: cp_ddapc_env
700 NULLIFY (cp_ddapc_env)
701 CALL timeset(routinen, handle)
703 ndim =
SIZE(particle_set)*
SIZE(radii)
706 ALLOCATE (ddbv(ndim))
707 rvec = particle_set(iparticle)%r
708 cp_ddapc_env => qs_env%cp_ddapc_env
712 particle_set(iparticle)%r(i) = rvec(i) + dx
713 CALL build_b_vector(bv1, cp_ddapc_env%gfunc, cp_ddapc_env%w, &
714 particle_set, radii, rho_tot_g, gcut); bv1(:) = bv1(:)/vol
715 CALL rho_tot_g%pw_grid%para%group%sum(bv1)
716 particle_set(iparticle)%r(i) = rvec(i) - dx
717 CALL build_b_vector(bv2, cp_ddapc_env%gfunc, cp_ddapc_env%w, &
718 particle_set, radii, rho_tot_g, gcut); bv2(:) = bv2(:)/vol
719 CALL rho_tot_g%pw_grid%para%group%sum(bv2)
720 ddbv(:) = (bv1(:) - bv2(:))/(2.0_dp*dx)
721 DO kk = 1,
SIZE(ddbv)
722 IF (ddbv(kk) .GT. 1.0e-8_dp)
THEN
723 v0 = abs(dbv(kk, i) - ddbv(kk))/ddbv(kk)*100.0_dp
724 WRITE (*, *)
"Error % on B ::", v0
725 IF (v0 .GT. 0.1_dp)
THEN
726 WRITE (*,
'(A,2I5,2F15.9)')
"ERROR IN DERIVATIVE OF B VECTOR, IPARTICLE, ICOORD:", iparticle, i, &
732 particle_set(iparticle)%r = rvec
737 CALL timestop(handle)
738 END SUBROUTINE debug_der_b_vector
755 SUBROUTINE debug_der_a_matrix(dAm, particle_set, radii, &
756 rho_tot_g, gcut, iparticle, Vol, qs_env)
757 REAL(kind=dp),
DIMENSION(:, :, :),
INTENT(IN) :: dam
758 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
759 REAL(kind=dp),
DIMENSION(:),
POINTER :: radii
760 TYPE(pw_c1d_gs_type),
INTENT(IN) :: rho_tot_g
761 REAL(kind=dp),
INTENT(IN) :: gcut
762 INTEGER,
INTENT(in) :: iparticle
763 REAL(kind=dp),
INTENT(IN) :: vol
764 TYPE(qs_environment_type),
POINTER :: qs_env
766 CHARACTER(len=*),
PARAMETER :: routinen =
'debug_der_A_matrix'
768 INTEGER :: handle, i, kk, ll, ndim
769 REAL(kind=dp) :: dx, rvec(3), v0
770 REAL(kind=dp),
ALLOCATABLE,
DIMENSION(:, :) :: am1, am2, ddam, g_dot_rvec_cos, &
772 TYPE(cp_ddapc_type),
POINTER :: cp_ddapc_env
776 NULLIFY (cp_ddapc_env)
777 CALL timeset(routinen, handle)
779 ndim =
SIZE(particle_set)*
SIZE(radii)
780 ALLOCATE (am1(ndim, ndim))
781 ALLOCATE (am2(ndim, ndim))
782 ALLOCATE (ddam(ndim, ndim))
783 rvec = particle_set(iparticle)%r
784 cp_ddapc_env => qs_env%cp_ddapc_env
785 CALL prep_g_dot_rvec_sin_cos(rho_tot_g, particle_set, gcut, g_dot_rvec_sin, g_dot_rvec_cos)
789 particle_set(iparticle)%r(i) = rvec(i) + dx
790 CALL build_a_matrix(am1, cp_ddapc_env%gfunc, cp_ddapc_env%w, &
791 particle_set, radii, rho_tot_g, gcut, g_dot_rvec_sin, g_dot_rvec_cos)
792 am1(:, :) = am1(:, :)/(vol*vol)
793 CALL rho_tot_g%pw_grid%para%group%sum(am1)
794 particle_set(iparticle)%r(i) = rvec(i) - dx
795 CALL build_a_matrix(am2, cp_ddapc_env%gfunc, cp_ddapc_env%w, &
796 particle_set, radii, rho_tot_g, gcut, g_dot_rvec_sin, g_dot_rvec_cos)
797 am2(:, :) = am2(:, :)/(vol*vol)
798 CALL rho_tot_g%pw_grid%para%group%sum(am2)
799 ddam(:, :) = (am1 - am2)/(2.0_dp*dx)
800 DO kk = 1,
SIZE(ddam, 1)
801 DO ll = 1,
SIZE(ddam, 2)
802 IF (ddam(kk, ll) .GT. 1.0e-8_dp)
THEN
803 v0 = abs(dam(kk, ll, i) - ddam(kk, ll))/ddam(kk, ll)*100.0_dp
804 WRITE (*, *)
"Error % on A ::", v0, am1(kk, ll), am2(kk, ll), iparticle, i, kk, ll
805 IF (v0 .GT. 0.1_dp)
THEN
806 WRITE (*,
'(A,4I5,2F15.9)')
"ERROR IN DERIVATIVE OF A MATRIX, IPARTICLE, ICOORD:", iparticle, i, kk, ll, &
807 dam(kk, ll, i), ddam(kk, ll)
813 particle_set(iparticle)%r = rvec
815 CALL cleanup_g_dot_rvec_sin_cos(g_dot_rvec_sin, g_dot_rvec_cos)
819 CALL timestop(handle)
820 END SUBROUTINE debug_der_a_matrix
835 SUBROUTINE debug_charge(dqv, qs_env, density_fit_section, &
836 particle_set, radii, rho_tot_g, type_of_density)
837 REAL(kind=dp),
DIMENSION(:, :, :),
INTENT(IN) :: dqv
838 TYPE(qs_environment_type),
POINTER :: qs_env
839 TYPE(section_vals_type),
POINTER :: density_fit_section
840 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
841 REAL(kind=dp),
DIMENSION(:),
POINTER :: radii
842 TYPE(pw_c1d_gs_type),
INTENT(IN) :: rho_tot_g
843 CHARACTER(LEN=*) :: type_of_density
845 CHARACTER(len=*),
PARAMETER :: routinen =
'debug_charge'
847 INTEGER :: handle, i, iparticle, kk, ndim
848 REAL(kind=dp) :: dx, rvec(3)
849 REAL(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: ddqv
850 REAL(kind=dp),
DIMENSION(:),
POINTER :: qtot1, qtot2
852 CALL timeset(routinen, handle)
853 WRITE (*, *)
"DEBUG_CHARGE_ROUTINE"
854 ndim =
SIZE(particle_set)*
SIZE(radii)
855 NULLIFY (qtot1, qtot2)
856 ALLOCATE (qtot1(ndim))
857 ALLOCATE (qtot2(ndim))
858 ALLOCATE (ddqv(ndim))
861 DO iparticle = 1,
SIZE(particle_set)
862 rvec = particle_set(iparticle)%r
864 particle_set(iparticle)%r(i) = rvec(i) + dx
865 CALL get_ddapc(qs_env, .false., density_fit_section, qout1=qtot1, &
866 ext_rho_tot_g=rho_tot_g, itype_of_density=type_of_density)
867 particle_set(iparticle)%r(i) = rvec(i) - dx
868 CALL get_ddapc(qs_env, .false., density_fit_section, qout1=qtot2, &
869 ext_rho_tot_g=rho_tot_g, itype_of_density=type_of_density)
870 ddqv(:) = (qtot1 - qtot2)/(2.0_dp*dx)
871 DO kk = 1,
SIZE(qtot1) - 1,
SIZE(radii)
872 IF (any(ddqv(kk:kk + 2) .GT. 1.0e-8_dp))
THEN
873 WRITE (*,
'(A,2F12.6,F12.2)')
"Error :", sum(dqv(kk:kk + 2, iparticle, i)), sum(ddqv(kk:kk + 2)), &
874 abs((sum(ddqv(kk:kk + 2)) - sum(dqv(kk:kk + 2, iparticle, i)))/sum(ddqv(kk:kk + 2))*100.0_dp)
877 particle_set(iparticle)%r = rvec
884 CALL timestop(handle)
885 END SUBROUTINE debug_charge
static GRID_HOST_DEVICE double fac(const int i)
Factorial function, e.g. fac(5) = 5! = 120.
static void dgemm(const char transa, const char transb, const int m, const int n, const int k, const double alpha, const double *a, const int lda, const double *b, const int ldb, const double beta, double *c, const int ldc)
Convenient wrapper to hide Fortran nature of dgemm_, swapping a and b.
simple routine to print charges for all atomic charge methods (currently mulliken,...
subroutine, public print_atomic_charges(particle_set, qs_kind_set, scr, title, electronic_charges, atomic_charges)
generates a unified output format for atomic charges
Handles all functions related to the CELL.
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Density Derived atomic point charges from a QM calculation (see J. Chem. Phys. Vol....
subroutine, public evaluate_restraint_functional(ddapc_restraint_control, n_gauss, uv, charges, energy_res)
computes energy and derivatives given a set of charges
contains information regarding the decoupling/recoupling method of Bloechl
subroutine, public cleanup_g_dot_rvec_sin_cos(g_dot_rvec_sin, g_dot_rvec_cos)
deallocate g_dot_rvec_* arrays
subroutine, public build_der_b_vector(dbv, gfunc, w, particle_set, radii, rho_tot_g, gcut, iparticle0)
Computes the derivative of B vector for the evaluation of the Pulay forces.
subroutine, public build_b_vector(bv, gfunc, w, particle_set, radii, rho_tot_g, gcut)
Computes the B vector for the solution of the linear system.
subroutine, public build_a_matrix(am, gfunc, w, particle_set, radii, rho_tot_g, gcut, g_dot_rvec_sin, g_dot_rvec_cos)
Computes the A matrix for the solution of the linear system.
subroutine, public prep_g_dot_rvec_sin_cos(rho_tot_g, particle_set, gcut, g_dot_rvec_sin, g_dot_rvec_cos)
precompute sin(g.r) and cos(g.r) for quicker evaluations of sin(g.(r1-r2)) and cos(g....
subroutine, public build_der_a_matrix_rows(dam, gfunc, w, particle_set, radii, rho_tot_g, gcut, iparticle0, nparticles, g_dot_rvec_sin, g_dot_rvec_cos)
Computes the derivative of the A matrix for the evaluation of the Pulay forces.
contains information regarding the decoupling/recoupling method of Bloechl
subroutine, public cp_ddapc_create(cp_para_env, cp_ddapc_env, cp_ddapc_ewald, particle_set, radii, cell, super_cell, rho_tot_g, gcut, iw2, vol, force_env_section)
...
Density Derived atomic point charges from a QM calculation (see Bloechl, J. Chem. Phys....
subroutine, public cp_ddapc_init(qs_env)
Initialize the cp_ddapc_environment.
recursive subroutine, public get_ddapc(qs_env, calc_force, density_fit_section, density_type, qout1, qout2, out_radii, dq_out, ext_rho_tot_g, itype_of_density, iwc)
Computes the Density Derived Atomic Point Charges.
subroutine, public modify_hartree_pot(v_hartree_gspace, density_fit_section, particle_set, m, ami, radii, charges)
Modify the Hartree potential.
subroutine, public restraint_functional_potential(v_hartree_gspace, density_fit_section, particle_set, ami, radii, charges, ddapc_restraint_control, energy_res)
modify hartree potential to handle restraints in DDAPC scheme
various routines to log and control the output. The idea is that decisions about where to log should ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
real(kind=dp), dimension(0:maxfac), parameter, public fac
Interface to the message passing library MPI.
Define the data structure for the particle information.
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
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
container for information about total charges on the grids
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_pp, 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, harris_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, eeq, rhs)
Get the QUICKSTEP environment.
Define the quickstep kind type and their sub types.
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...
Type defining parameters related to the simulation cell.
type of a logger, at the moment it contains just a print level starting at which level it should be l...
stores all the informations relevant to an mpi environment
contained for different pw related things
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Container for information about total charges on the grids.
Provides all information about a quickstep kind.
keeps the density in various representations, keeping track of which ones are valid.