86#include "./base/base_uses.f90"
94 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_resp'
99 LOGICAL :: equal_charges = .false., itc = .false., &
100 molecular_sys = .false., rheavies = .false., &
101 use_repeat_method = .false.
102 INTEGER :: nres = -1, ncons = -1, &
103 nrest_sec = -1, ncons_sec = -1, &
104 npoints = -1, stride(3) = -1, my_fit = -1, &
106 auto_vdw_radii_table = -1
107 INTEGER,
DIMENSION(:),
POINTER :: atom_surf_list => null()
108 INTEGER,
DIMENSION(:, :),
POINTER :: fitpoints => null()
109 REAL(KIND=
dp) :: rheavies_strength = -1.0_dp, &
110 length = -1.0_dp, eta = -1.0_dp, &
111 sum_vhartree = -1.0_dp, offset = -1.0_dp
112 REAL(KIND=
dp),
DIMENSION(3) :: box_hi = -1.0_dp, box_low = -1.0_dp
113 REAL(KIND=
dp),
DIMENSION(:),
POINTER :: rmin_kind => null(), &
115 REAL(KIND=
dp),
DIMENSION(:),
POINTER :: range_surf => null()
116 REAL(KIND=
dp),
DIMENSION(:),
POINTER :: rhs => null()
117 REAL(KIND=
dp),
DIMENSION(:),
POINTER :: sum_vpot => null()
118 REAL(KIND=
dp),
DIMENSION(:, :),
POINTER :: matrix => null()
122 TYPE(resp_type),
POINTER :: p_resp => null()
134 CHARACTER(len=*),
PARAMETER :: routinen =
'resp_fit'
136 INTEGER :: handle, info, my_per, natom, nvar, &
138 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: ipiv
140 REAL(kind=
dp),
DIMENSION(:),
POINTER :: rhs_to_save
148 TYPE(resp_p_type),
DIMENSION(:),
POINTER :: rep_sys
149 TYPE(resp_type),
POINTER :: resp_env
151 resp_section, rest_section
153 CALL timeset(routinen, handle)
155 NULLIFY (logger, atomic_kind_set, cell, subsys, particles, particle_set, input, &
156 resp_section, cons_section, rest_section, poisson_section, resp_env, rep_sys)
158 cpassert(
ASSOCIATED(qs_env))
160 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, input=input, &
161 subsys=subsys, particle_set=particle_set, cell=cell)
169 CALL create_resp_type(resp_env, rep_sys)
171 CALL init_resp(resp_env, rep_sys, subsys, atomic_kind_set, &
172 cell, resp_section, cons_section, rest_section)
175 CALL print_resp_parameter_info(qs_env, resp_env, rep_sys, my_per)
178 natom = particles%n_els
179 nvar = natom + resp_env%ncons
181 CALL resp_allocate(resp_env, natom, nvar)
182 ALLOCATE (ipiv(nvar))
188 CALL calc_resp_matrix_nonper(qs_env, resp_env, atomic_kind_set, particles, cell, &
189 resp_env%matrix, resp_env%rhs, natom)
192 IF (resp_env%use_repeat_method)
CALL cite_reference(
campana2009)
193 CALL calc_resp_matrix_periodic(qs_env, resp_env, rep_sys, particles, cell, natom)
195 CALL cp_abort(__location__, &
196 "RESP charges only implemented for nonperiodic systems"// &
197 " or XYZ periodicity!")
202 IF (output_unit > 0)
THEN
203 WRITE (output_unit,
'(T3,A,T69,I12)')
"Number of fitting points "// &
204 "found: ", resp_env%npoints
205 WRITE (output_unit,
'()')
209 CALL add_restraints_and_constraints(qs_env, resp_env, rest_section, &
210 subsys, natom, cons_section, particle_set)
213 CALL dgetrf(nvar, nvar, resp_env%matrix, nvar, ipiv, info)
216 CALL dgetrs(
'N', nvar, 1, resp_env%matrix, nvar, ipiv, resp_env%rhs, nvar, info)
219 IF (resp_env%use_repeat_method) resp_env%offset = resp_env%rhs(natom + 1)
220 CALL print_resp_charges(qs_env, resp_env, output_unit, natom)
221 CALL print_fitting_points(qs_env, resp_env)
222 CALL print_pot_from_resp_charges(qs_env, resp_env, particles, natom, output_unit)
225 NULLIFY (dft_control)
226 CALL get_qs_env(qs_env, dft_control=dft_control)
227 IF (dft_control%qs_control%ref_embed_subsys)
THEN
228 ALLOCATE (rhs_to_save(
SIZE(resp_env%rhs)))
229 rhs_to_save = resp_env%rhs
234 CALL resp_dealloc(resp_env, rep_sys)
236 "PRINT%PROGRAM_RUN_INFO")
240 CALL timestop(handle)
249 SUBROUTINE create_resp_type(resp_env, rep_sys)
250 TYPE(resp_type),
POINTER :: resp_env
251 TYPE(resp_p_type),
DIMENSION(:),
POINTER :: rep_sys
253 IF (
ASSOCIATED(resp_env))
CALL resp_dealloc(resp_env, rep_sys)
256 NULLIFY (resp_env%matrix, &
257 resp_env%fitpoints, &
258 resp_env%rmin_kind, &
259 resp_env%rmax_kind, &
263 resp_env%equal_charges = .false.
264 resp_env%itc = .false.
265 resp_env%molecular_sys = .false.
266 resp_env%rheavies = .false.
267 resp_env%use_repeat_method = .false.
269 resp_env%box_hi = 0.0_dp
270 resp_env%box_low = 0.0_dp
273 resp_env%ncons_sec = 0
275 resp_env%nrest_sec = 0
277 resp_env%npoints_proc = 0
280 END SUBROUTINE create_resp_type
288 SUBROUTINE resp_allocate(resp_env, natom, nvar)
289 TYPE(resp_type),
POINTER :: resp_env
290 INTEGER,
INTENT(IN) :: natom, nvar
292 IF (.NOT.
ASSOCIATED(resp_env%matrix))
THEN
293 ALLOCATE (resp_env%matrix(nvar, nvar))
295 IF (.NOT.
ASSOCIATED(resp_env%rhs))
THEN
296 ALLOCATE (resp_env%rhs(nvar))
298 IF (.NOT.
ASSOCIATED(resp_env%sum_vpot))
THEN
299 ALLOCATE (resp_env%sum_vpot(natom))
301 resp_env%matrix = 0.0_dp
302 resp_env%rhs = 0.0_dp
303 resp_env%sum_vpot = 0.0_dp
305 END SUBROUTINE resp_allocate
312 SUBROUTINE resp_dealloc(resp_env, rep_sys)
313 TYPE(resp_type),
POINTER :: resp_env
314 TYPE(resp_p_type),
DIMENSION(:),
POINTER :: rep_sys
318 IF (
ASSOCIATED(resp_env))
THEN
319 IF (
ASSOCIATED(resp_env%matrix))
THEN
320 DEALLOCATE (resp_env%matrix)
322 IF (
ASSOCIATED(resp_env%rhs))
THEN
323 DEALLOCATE (resp_env%rhs)
325 IF (
ASSOCIATED(resp_env%sum_vpot))
THEN
326 DEALLOCATE (resp_env%sum_vpot)
328 IF (
ASSOCIATED(resp_env%fitpoints))
THEN
329 DEALLOCATE (resp_env%fitpoints)
331 IF (
ASSOCIATED(resp_env%rmin_kind))
THEN
332 DEALLOCATE (resp_env%rmin_kind)
334 IF (
ASSOCIATED(resp_env%rmax_kind))
THEN
335 DEALLOCATE (resp_env%rmax_kind)
337 DEALLOCATE (resp_env)
339 IF (
ASSOCIATED(rep_sys))
THEN
340 DO i = 1,
SIZE(rep_sys)
341 DEALLOCATE (rep_sys(i)%p_resp%atom_surf_list)
342 DEALLOCATE (rep_sys(i)%p_resp)
347 END SUBROUTINE resp_dealloc
360 SUBROUTINE init_resp(resp_env, rep_sys, subsys, atomic_kind_set, &
361 cell, resp_section, cons_section, rest_section)
363 TYPE(resp_type),
POINTER :: resp_env
364 TYPE(resp_p_type),
DIMENSION(:),
POINTER :: rep_sys
370 CHARACTER(len=*),
PARAMETER :: routinen =
'init_resp'
372 INTEGER :: handle, i, nrep
373 INTEGER,
DIMENSION(:),
POINTER :: atom_list_cons, my_stride
377 CALL timeset(routinen, handle)
379 NULLIFY (atom_list_cons, my_stride, sphere_section, slab_section)
390 IF (resp_env%itc) resp_env%ncons = resp_env%ncons + 1
393 l_val=resp_env%rheavies)
394 IF (resp_env%rheavies)
THEN
396 r_val=resp_env%rheavies_strength)
399 IF (
SIZE(my_stride) /= 1 .AND.
SIZE(my_stride) /= 3) &
400 CALL cp_abort(__location__,
"STRIDE keyword can accept only 1 (the same for X,Y,Z) "// &
401 "or 3 values. Correct your input file.")
402 IF (
SIZE(my_stride) == 1)
THEN
404 resp_env%stride(i) = my_stride(1)
407 resp_env%stride = my_stride(1:3)
413 l_val=resp_env%use_repeat_method)
414 IF (resp_env%use_repeat_method)
THEN
415 resp_env%ncons = resp_env%ncons + 1
417 resp_env%rheavies = .false.
422 CALL get_parameter_molecular_sys(resp_env, sphere_section, cell, &
428 IF (resp_env%molecular_sys)
THEN
429 CALL cp_abort(__location__, &
430 "You can only use either SPHERE_SAMPLING or SLAB_SAMPLING, but "// &
433 ALLOCATE (rep_sys(nrep))
435 ALLOCATE (rep_sys(i)%p_resp)
436 NULLIFY (rep_sys(i)%p_resp%range_surf, rep_sys(i)%p_resp%atom_surf_list)
442 i_rep_section=i, i_val=rep_sys(i)%p_resp%my_fit)
443 IF (any(rep_sys(i)%p_resp%range_surf < 0.0_dp))
THEN
444 cpabort(
"Numbers in RANGE in SLAB_SAMPLING cannot be negative.")
446 IF (rep_sys(i)%p_resp%length <= epsilon(0.0_dp))
THEN
447 cpabort(
"Parameter LENGTH in SLAB_SAMPLING has to be larger than zero.")
450 CALL build_atom_list(slab_section, subsys, rep_sys(i)%p_resp%atom_surf_list, rep=i)
458 DO i = 1, resp_env%ncons_sec
460 l_val=resp_env%equal_charges, explicit=explicit)
461 IF (.NOT. explicit) cycle
462 CALL build_atom_list(cons_section, subsys, atom_list_cons, i)
464 resp_env%ncons = resp_env%ncons +
SIZE(atom_list_cons) - 2
465 DEALLOCATE (atom_list_cons)
472 resp_env%ncons = resp_env%ncons + resp_env%ncons_sec
473 resp_env%nres = resp_env%nres + resp_env%nrest_sec
475 CALL timestop(handle)
477 END SUBROUTINE init_resp
487 SUBROUTINE get_parameter_molecular_sys(resp_env, sphere_section, cell, &
490 TYPE(resp_type),
POINTER :: resp_env
495 CHARACTER(LEN=2) :: symbol
496 CHARACTER(LEN=default_string_length) :: missing_rmax, missing_rmin
497 CHARACTER(LEN=default_string_length), &
498 DIMENSION(:),
POINTER :: tmpstringlist
499 INTEGER :: ikind, j, kind_number, n_rmax_missing, &
500 n_rmin_missing, nkind, nrep_rmax, &
502 LOGICAL :: explicit, has_rmax, has_rmin
503 LOGICAL,
ALLOCATABLE,
DIMENSION(:) :: rmax_is_set, rmin_is_set
504 REAL(kind=
dp) :: auto_rmax_scale, auto_rmin_scale, rmax, &
506 REAL(kind=
dp),
DIMENSION(3, 3) :: hmat
511 nkind =
SIZE(atomic_kind_set)
518 resp_env%molecular_sys = .true.
520 i_val=resp_env%auto_vdw_radii_table)
527 ALLOCATE (resp_env%rmin_kind(nkind))
528 ALLOCATE (resp_env%rmax_kind(nkind))
529 resp_env%rmin_kind = 0.0_dp
530 resp_env%rmax_kind = 0.0_dp
531 ALLOCATE (rmin_is_set(nkind))
532 ALLOCATE (rmax_is_set(nkind))
533 rmin_is_set = .false.
534 rmax_is_set = .false.
537 atomic_kind => atomic_kind_set(ikind)
539 element_symbol=symbol, &
540 kind_number=kind_number, &
542 SELECT CASE (resp_env%auto_vdw_radii_table)
544 CALL get_ptable_info(symbol, vdw_radius=resp_env%rmin_kind(kind_number))
545 rmin_is_set(kind_number) = .true.
549 found=rmin_is_set(kind_number))
551 CALL get_ptable_info(symbol, vdw_radius=resp_env%rmin_kind(kind_number))
552 rmin_is_set(kind_number) = .true.
554 IF (rmin_is_set(kind_number))
THEN
555 resp_env%rmin_kind(kind_number) =
cp_unit_to_cp2k(resp_env%rmin_kind(kind_number), &
557 resp_env%rmin_kind(kind_number) = resp_env%rmin_kind(kind_number)*auto_rmin_scale
559 resp_env%rmax_kind(kind_number) = &
560 max(resp_env%rmin_kind(kind_number), &
561 resp_env%rmin_kind(kind_number)*auto_rmax_scale)
562 rmax_is_set(kind_number) = .true.
568 resp_env%rmin_kind = rmin
572 resp_env%rmax_kind = rmax
579 c_vals=tmpstringlist)
581 atomic_kind => atomic_kind_set(ikind)
582 CALL get_atomic_kind(atomic_kind, element_symbol=symbol, kind_number=kind_number)
583 IF (trim(tmpstringlist(2)) == trim(symbol))
THEN
584 READ (tmpstringlist(1), *) resp_env%rmin_kind(kind_number)
585 resp_env%rmin_kind(kind_number) = &
588 rmin_is_set(kind_number) = .true.
594 c_vals=tmpstringlist)
596 atomic_kind => atomic_kind_set(ikind)
597 CALL get_atomic_kind(atomic_kind, element_symbol=symbol, kind_number=kind_number)
598 IF (trim(tmpstringlist(2)) == trim(symbol))
THEN
599 READ (tmpstringlist(1), *) resp_env%rmax_kind(kind_number)
600 resp_env%rmax_kind(kind_number) =
cp_unit_to_cp2k(resp_env%rmax_kind(kind_number), &
602 rmax_is_set(kind_number) = .true.
612 atomic_kind => atomic_kind_set(ikind)
614 element_symbol=symbol, &
615 kind_number=kind_number)
616 IF (.NOT. rmin_is_set(kind_number))
THEN
617 n_rmin_missing = n_rmin_missing + 1
618 missing_rmin = trim(missing_rmin)//
" "//trim(symbol)//
","
620 IF (.NOT. rmax_is_set(kind_number))
THEN
621 n_rmax_missing = n_rmax_missing + 1
622 missing_rmax = trim(missing_rmax)//
" "//trim(symbol)//
","
625 IF (n_rmin_missing > 0)
THEN
626 CALL cp_warn(__location__, &
627 "RMIN for the following elements are missing: "// &
628 trim(missing_rmin)// &
629 " please set these values manually using "// &
630 "RMIN_KIND in SPHERE_SAMPLING section")
632 IF (n_rmax_missing > 0)
THEN
633 CALL cp_warn(__location__, &
634 "RMAX for the following elements are missing: "// &
635 trim(missing_rmax)// &
636 " please set these values manually using "// &
637 "RMAX_KIND in SPHERE_SAMPLING section")
639 IF (n_rmin_missing > 0 .OR. &
640 n_rmax_missing > 0)
THEN
641 cpabort(
"Insufficient data for RMIN or RMAX")
645 resp_env%box_hi = (/hmat(1, 1), hmat(2, 2), hmat(3, 3)/)
646 resp_env%box_low = 0.0_dp
649 r_val=resp_env%box_hi(1))
652 r_val=resp_env%box_low(1))
655 r_val=resp_env%box_hi(2))
658 r_val=resp_env%box_low(2))
661 r_val=resp_env%box_hi(3))
664 r_val=resp_env%box_low(3))
666 DEALLOCATE (rmin_is_set)
667 DEALLOCATE (rmax_is_set)
670 END SUBROUTINE get_parameter_molecular_sys
681 SUBROUTINE build_atom_list(section, subsys, atom_list, rep)
685 INTEGER,
DIMENSION(:),
POINTER :: atom_list
686 INTEGER,
INTENT(IN),
OPTIONAL :: rep
688 CHARACTER(len=*),
PARAMETER :: routinen =
'build_atom_list'
690 INTEGER :: atom_a, atom_b, handle, i, irep, j, &
691 max_index, n_var, num_atom
692 INTEGER,
DIMENSION(:),
POINTER :: indexes
693 LOGICAL :: index_in_range
695 CALL timeset(routinen, handle)
699 IF (
PRESENT(rep)) irep = rep
706 i_rep_val=i, i_vals=indexes)
707 num_atom = num_atom +
SIZE(indexes)
709 ALLOCATE (atom_list(num_atom))
714 i_rep_val=i, i_vals=indexes)
715 atom_list(num_atom:num_atom +
SIZE(indexes) - 1) = indexes(:)
716 num_atom = num_atom +
SIZE(indexes)
719 num_atom = num_atom - 1
721 cpassert(
SIZE(atom_list) /= 0)
722 index_in_range = (maxval(atom_list) <= max_index) &
723 .AND. (minval(atom_list) > 0)
724 cpassert(index_in_range)
726 DO j = i + 1, num_atom
727 atom_a = atom_list(i)
728 atom_b = atom_list(j)
729 IF (atom_a == atom_b) &
730 cpabort(
"There are atoms doubled in atom list for RESP.")
734 CALL timestop(handle)
736 END SUBROUTINE build_atom_list
749 SUBROUTINE calc_resp_matrix_nonper(qs_env, resp_env, atomic_kind_set, particles, &
750 cell, matrix, rhs, natom)
753 TYPE(resp_type),
POINTER :: resp_env
757 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: matrix
758 REAL(kind=
dp),
DIMENSION(:),
POINTER :: rhs
759 INTEGER,
INTENT(IN) :: natom
761 CHARACTER(len=*),
PARAMETER :: routinen =
'calc_resp_matrix_nonper'
763 INTEGER :: bo(2, 3), gbo(2, 3), handle, i, ikind, &
764 jx, jy, jz, k, kind_number, l, m, &
766 LOGICAL,
ALLOCATABLE,
DIMENSION(:, :) :: not_in_range
767 REAL(kind=
dp) :: delta, dh(3, 3), dvol, r(3), rmax, rmin, &
768 vec(3), vec_pbc(3), vj
769 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: dist
770 REAL(kind=
dp),
DIMENSION(3, 3) :: hmat, hmat_inv
774 CALL timeset(routinen, handle)
776 NULLIFY (particle_set, v_hartree_pw)
779 CALL get_cell(cell=cell, h=hmat, h_inv=hmat_inv)
781 IF (.NOT. cell%orthorhombic)
THEN
782 CALL cp_abort(__location__, &
783 "Nonperiodic solution for RESP charges only"// &
784 " implemented for orthorhombic cells!")
786 IF (.NOT. resp_env%molecular_sys)
THEN
787 CALL cp_abort(__location__, &
788 "Nonperiodic solution for RESP charges (i.e. nonperiodic"// &
789 " Poisson solver) can only be used with section SPHERE_SAMPLING")
791 IF (resp_env%use_repeat_method)
THEN
792 CALL cp_abort(__location__, &
793 "REPEAT method only reasonable for periodic RESP fitting")
795 CALL get_qs_env(qs_env, particle_set=particle_set, v_hartree_rspace=v_hartree_pw)
797 bo = v_hartree_pw%pw_grid%bounds_local
798 gbo = v_hartree_pw%pw_grid%bounds
799 np = v_hartree_pw%pw_grid%npts
800 dh = v_hartree_pw%pw_grid%dh
801 dvol = v_hartree_pw%pw_grid%dvol
802 nkind =
SIZE(atomic_kind_set)
804 ALLOCATE (dist(natom))
805 ALLOCATE (not_in_range(natom, 2))
808 IF (.NOT.
ASSOCIATED(resp_env%fitpoints))
THEN
810 ALLOCATE (resp_env%fitpoints(3, now))
812 now =
SIZE(resp_env%fitpoints, 2)
815 DO jz = bo(1, 3), bo(2, 3)
816 DO jy = bo(1, 2), bo(2, 2)
817 DO jx = bo(1, 1), bo(2, 1)
818 IF (.NOT. (
modulo(jz, resp_env%stride(3)) == 0)) cycle
819 IF (.NOT. (
modulo(jy, resp_env%stride(2)) == 0)) cycle
820 IF (.NOT. (
modulo(jx, resp_env%stride(1)) == 0)) cycle
825 r(3) = p*dh(3, 3) + k*dh(3, 2) + l*dh(3, 1)
826 r(2) = p*dh(2, 3) + k*dh(2, 2) + l*dh(2, 1)
827 r(1) = p*dh(1, 3) + k*dh(1, 2) + l*dh(1, 1)
828 IF (r(3) < resp_env%box_low(3) .OR. r(3) > resp_env%box_hi(3)) cycle
829 IF (r(2) < resp_env%box_low(2) .OR. r(2) > resp_env%box_hi(2)) cycle
830 IF (r(1) < resp_env%box_low(1) .OR. r(1) > resp_env%box_hi(1)) cycle
832 not_in_range = .false.
834 vec = r - particles%els(i)%r
835 vec_pbc(1) = vec(1) - hmat(1, 1)*anint(hmat_inv(1, 1)*vec(1))
836 vec_pbc(2) = vec(2) - hmat(2, 2)*anint(hmat_inv(2, 2)*vec(2))
837 vec_pbc(3) = vec(3) - hmat(3, 3)*anint(hmat_inv(3, 3)*vec(3))
838 dist(i) = sqrt(sum(vec_pbc**2))
840 kind_number=kind_number)
842 IF (ikind == kind_number)
THEN
843 rmin = resp_env%rmin_kind(ikind)
844 rmax = resp_env%rmax_kind(ikind)
848 IF (dist(i) < rmin + delta) not_in_range(i, 1) = .true.
849 IF (dist(i) > rmax - delta) not_in_range(i, 2) = .true.
853 IF (any(not_in_range(:, 1)) .OR. all(not_in_range(:, 2))) cycle
854 resp_env%npoints_proc = resp_env%npoints_proc + 1
855 IF (resp_env%npoints_proc > now)
THEN
857 CALL reallocate(resp_env%fitpoints, 1, 3, 1, now)
859 resp_env%fitpoints(1, resp_env%npoints_proc) = jx
860 resp_env%fitpoints(2, resp_env%npoints_proc) = jy
861 resp_env%fitpoints(3, resp_env%npoints_proc) = jz
863 IF (qs_env%qmmm)
THEN
865 vj = -v_hartree_pw%array(jx, jy, jz)/dvol + qs_env%ks_qmmm_env%v_qmmm_rspace%array(jx, jy, jz)
867 vj = -v_hartree_pw%array(jx, jy, jz)/dvol
869 dist(:) = 1.0_dp/dist(:)
873 matrix(m, i) = matrix(m, i) + 2.0_dp*dist(i)*dist(m)
875 rhs(i) = rhs(i) + 2.0_dp*vj*dist(i)
881 resp_env%npoints = resp_env%npoints_proc
882 CALL v_hartree_pw%pw_grid%para%group%sum(resp_env%npoints)
883 CALL v_hartree_pw%pw_grid%para%group%sum(matrix)
884 CALL v_hartree_pw%pw_grid%para%group%sum(rhs)
886 matrix = matrix/resp_env%npoints
887 rhs = rhs/resp_env%npoints
890 DEALLOCATE (not_in_range)
892 CALL timestop(handle)
894 END SUBROUTINE calc_resp_matrix_nonper
905 SUBROUTINE calc_resp_matrix_periodic(qs_env, resp_env, rep_sys, particles, cell, &
909 TYPE(resp_type),
POINTER :: resp_env
910 TYPE(resp_p_type),
DIMENSION(:),
POINTER :: rep_sys
913 INTEGER,
INTENT(IN) :: natom
915 CHARACTER(len=*),
PARAMETER :: routinen =
'calc_resp_matrix_periodic'
917 INTEGER :: handle, i, ip, j, jx, jy, jz
918 INTEGER,
DIMENSION(3) :: periodic
919 REAL(kind=
dp) :: normalize_factor
920 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: vpot
928 CALL timeset(routinen, handle)
930 NULLIFY (pw_env, para_env, auxbas_pw_pool, poisson_env)
932 CALL get_cell(cell=cell, periodic=periodic)
934 IF (.NOT. all(periodic /= 0))
THEN
935 CALL cp_abort(__location__, &
936 "Periodic solution for RESP (with periodic Poisson solver)"// &
937 " can only be obtained with a cell that has XYZ periodicity")
940 CALL get_qs_env(qs_env, pw_env=pw_env, para_env=para_env)
942 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
943 poisson_env=poisson_env)
944 CALL auxbas_pw_pool%create_pw(rho_ga)
945 CALL auxbas_pw_pool%create_pw(va_gspace)
946 CALL auxbas_pw_pool%create_pw(va_rspace)
949 CALL get_fitting_points(qs_env, resp_env, rep_sys, particles=particles, &
951 ALLOCATE (vpot(resp_env%npoints_proc, natom))
952 normalize_factor = sqrt((resp_env%eta/
pi)**3)
963 CALL pw_scale(va_rspace, normalize_factor)
964 DO ip = 1, resp_env%npoints_proc
965 jx = resp_env%fitpoints(1, ip)
966 jy = resp_env%fitpoints(2, ip)
967 jz = resp_env%fitpoints(3, ip)
968 vpot(ip, i) = va_rspace%array(jx, jy, jz)
972 CALL va_gspace%release()
973 CALL va_rspace%release()
974 CALL rho_ga%release()
979 resp_env%matrix(i, j) = resp_env%matrix(i, j) + 2.0_dp*sum(vpot(:, i)*vpot(:, j))
982 CALL calculate_rhs(qs_env, resp_env, resp_env%rhs(i), vpot(:, i))
985 CALL para_env%sum(resp_env%matrix)
986 CALL para_env%sum(resp_env%rhs)
988 resp_env%matrix = resp_env%matrix/resp_env%npoints
989 resp_env%rhs = resp_env%rhs/resp_env%npoints
992 IF (resp_env%use_repeat_method)
THEN
995 resp_env%sum_vpot(i) = 2.0_dp*
accurate_sum(vpot(:, i))/resp_env%npoints
997 CALL para_env%sum(resp_env%sum_vpot)
998 CALL para_env%sum(resp_env%sum_vhartree)
999 resp_env%sum_vhartree = 2.0_dp*resp_env%sum_vhartree/resp_env%npoints
1003 CALL timestop(handle)
1005 END SUBROUTINE calc_resp_matrix_periodic
1015 SUBROUTINE get_fitting_points(qs_env, resp_env, rep_sys, particles, cell)
1018 TYPE(resp_type),
POINTER :: resp_env
1019 TYPE(resp_p_type),
DIMENSION(:),
POINTER :: rep_sys
1023 CHARACTER(len=*),
PARAMETER :: routinen =
'get_fitting_points'
1025 INTEGER :: bo(2, 3), gbo(2, 3), handle, i, iatom, &
1026 ikind, in_x, in_y, in_z, jx, jy, jz, &
1027 k, kind_number, l, m, natom, nkind, &
1029 LOGICAL,
ALLOCATABLE,
DIMENSION(:, :) :: not_in_range
1030 REAL(kind=
dp) :: delta, dh(3, 3), r(3), rmax, rmin, &
1032 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: dist
1038 CALL timeset(routinen, handle)
1040 NULLIFY (atomic_kind_set, v_hartree_pw, para_env, particle_set)
1044 particle_set=particle_set, &
1045 atomic_kind_set=atomic_kind_set, &
1046 para_env=para_env, &
1047 v_hartree_rspace=v_hartree_pw)
1049 bo = v_hartree_pw%pw_grid%bounds_local
1050 gbo = v_hartree_pw%pw_grid%bounds
1051 dh = v_hartree_pw%pw_grid%dh
1052 natom =
SIZE(particles%els)
1053 nkind =
SIZE(atomic_kind_set)
1055 IF (.NOT.
ASSOCIATED(resp_env%fitpoints))
THEN
1057 ALLOCATE (resp_env%fitpoints(3, now))
1059 now =
SIZE(resp_env%fitpoints, 2)
1062 ALLOCATE (dist(natom))
1063 ALLOCATE (not_in_range(natom, 2))
1066 DO jz = bo(1, 3), bo(2, 3)
1067 IF (.NOT. (
modulo(jz, resp_env%stride(3)) == 0)) cycle
1068 DO jy = bo(1, 2), bo(2, 2)
1069 IF (.NOT. (
modulo(jy, resp_env%stride(2)) == 0)) cycle
1070 DO jx = bo(1, 1), bo(2, 1)
1071 IF (.NOT. (
modulo(jx, resp_env%stride(1)) == 0)) cycle
1076 r(3) = p*dh(3, 3) + k*dh(3, 2) + l*dh(3, 1)
1077 r(2) = p*dh(2, 3) + k*dh(2, 2) + l*dh(2, 1)
1078 r(1) = p*dh(1, 3) + k*dh(1, 2) + l*dh(1, 1)
1079 IF (resp_env%molecular_sys)
THEN
1080 not_in_range = .false.
1082 vec_pbc =
pbc(r, particles%els(m)%r, cell)
1083 dist(m) = sqrt(sum(vec_pbc**2))
1085 kind_number=kind_number)
1087 IF (ikind == kind_number)
THEN
1088 rmin = resp_env%rmin_kind(ikind)
1089 rmax = resp_env%rmax_kind(ikind)
1093 IF (dist(m) < rmin + delta) not_in_range(m, 1) = .true.
1094 IF (dist(m) > rmax - delta) not_in_range(m, 2) = .true.
1096 IF (any(not_in_range(:, 1)) .OR. all(not_in_range(:, 2))) cycle
1098 DO i = 1,
SIZE(rep_sys)
1099 DO m = 1,
SIZE(rep_sys(i)%p_resp%atom_surf_list)
1103 iatom = rep_sys(i)%p_resp%atom_surf_list(m)
1104 SELECT CASE (rep_sys(i)%p_resp%my_fit)
1106 vec_pbc =
pbc(particles%els(iatom)%r, r, cell)
1108 vec_pbc =
pbc(r, particles%els(iatom)%r, cell)
1110 SELECT CASE (rep_sys(i)%p_resp%my_fit)
1113 IF (abs(vec_pbc(3)) < rep_sys(i)%p_resp%length - delta) in_z = 1
1114 IF (abs(vec_pbc(2)) < rep_sys(i)%p_resp%length - delta) in_y = 1
1115 IF (vec_pbc(1) > rep_sys(i)%p_resp%range_surf(1) + delta .AND. &
1116 vec_pbc(1) < rep_sys(i)%p_resp%range_surf(2) - delta) in_x = 1
1118 IF (abs(vec_pbc(3)) < rep_sys(i)%p_resp%length - delta) in_z = 1
1119 IF (vec_pbc(2) > rep_sys(i)%p_resp%range_surf(1) + delta .AND. &
1120 vec_pbc(2) < rep_sys(i)%p_resp%range_surf(2) - delta) in_y = 1
1121 IF (abs(vec_pbc(1)) < rep_sys(i)%p_resp%length - delta) in_x = 1
1123 IF (vec_pbc(3) > rep_sys(i)%p_resp%range_surf(1) + delta .AND. &
1124 vec_pbc(3) < rep_sys(i)%p_resp%range_surf(2) - delta) in_z = 1
1125 IF (abs(vec_pbc(2)) < rep_sys(i)%p_resp%length - delta) in_y = 1
1126 IF (abs(vec_pbc(1)) < rep_sys(i)%p_resp%length - delta) in_x = 1
1128 IF (in_z*in_y*in_x == 1)
EXIT
1130 IF (in_z*in_y*in_x == 1)
EXIT
1132 IF (in_z*in_y*in_x == 0) cycle
1134 resp_env%npoints_proc = resp_env%npoints_proc + 1
1135 IF (resp_env%npoints_proc > now)
THEN
1137 CALL reallocate(resp_env%fitpoints, 1, 3, 1, now)
1139 resp_env%fitpoints(1, resp_env%npoints_proc) = jx
1140 resp_env%fitpoints(2, resp_env%npoints_proc) = jy
1141 resp_env%fitpoints(3, resp_env%npoints_proc) = jz
1146 resp_env%npoints = resp_env%npoints_proc
1147 CALL para_env%sum(resp_env%npoints)
1150 DEALLOCATE (not_in_range)
1152 CALL timestop(handle)
1154 END SUBROUTINE get_fitting_points
1163 SUBROUTINE calculate_rhs(qs_env, resp_env, rhs, vpot)
1166 TYPE(resp_type),
POINTER :: resp_env
1167 REAL(kind=
dp),
INTENT(INOUT) :: rhs
1168 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: vpot
1170 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rhs'
1172 INTEGER :: handle, ip, jx, jy, jz
1173 REAL(kind=
dp) :: dvol
1174 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: vhartree
1177 CALL timeset(routinen, handle)
1179 NULLIFY (v_hartree_pw)
1180 CALL get_qs_env(qs_env, v_hartree_rspace=v_hartree_pw)
1181 dvol = v_hartree_pw%pw_grid%dvol
1182 ALLOCATE (vhartree(resp_env%npoints_proc))
1187 DO ip = 1, resp_env%npoints_proc
1188 jx = resp_env%fitpoints(1, ip)
1189 jy = resp_env%fitpoints(2, ip)
1190 jz = resp_env%fitpoints(3, ip)
1191 vhartree(ip) = -v_hartree_pw%array(jx, jy, jz)/dvol
1192 IF (qs_env%qmmm)
THEN
1194 vhartree(ip) = vhartree(ip) + qs_env%ks_qmmm_env%v_qmmm_rspace%array(jx, jy, jz)
1196 rhs = rhs + 2.0_dp*vhartree(ip)*vpot(ip)
1199 IF (resp_env%use_repeat_method)
THEN
1203 DEALLOCATE (vhartree)
1205 CALL timestop(handle)
1207 END SUBROUTINE calculate_rhs
1215 SUBROUTINE print_fitting_points(qs_env, resp_env)
1218 TYPE(resp_type),
POINTER :: resp_env
1220 CHARACTER(len=*),
PARAMETER :: routinen =
'print_fitting_points'
1222 CHARACTER(LEN=2) :: element_symbol
1223 CHARACTER(LEN=default_path_length) :: filename
1224 INTEGER :: gbo(2, 3), handle, i, iatom, ip, jx, jy, &
1225 jz, k, l, my_pos, nobjects, &
1227 INTEGER,
DIMENSION(:),
POINTER :: tmp_npoints, tmp_size
1228 INTEGER,
DIMENSION(:, :),
POINTER :: tmp_points
1229 REAL(kind=
dp) :: conv, dh(3, 3), r(3)
1237 CALL timeset(routinen, handle)
1239 NULLIFY (para_env, input, logger, resp_section, print_key, particle_set, tmp_size, &
1240 tmp_points, tmp_npoints, v_hartree_pw)
1242 CALL get_qs_env(qs_env, input=input, para_env=para_env, &
1243 particle_set=particle_set, v_hartree_rspace=v_hartree_pw)
1245 gbo = v_hartree_pw%pw_grid%bounds
1246 dh = v_hartree_pw%pw_grid%dh
1247 nobjects =
SIZE(particle_set) + resp_env%npoints
1253 "PRINT%COORD_FIT_POINTS", &
1255 file_status=
"REPLACE", &
1256 file_action=
"WRITE", &
1257 file_form=
"FORMATTED")
1260 resp_section,
"PRINT%COORD_FIT_POINTS"), &
1262 IF (output_unit > 0)
THEN
1264 print_key, extension=
".xyz", &
1266 WRITE (unit=output_unit, fmt=
"(I12,/)") nobjects
1267 DO iatom = 1,
SIZE(particle_set)
1269 element_symbol=element_symbol)
1270 WRITE (unit=output_unit, fmt=
"(A,1X,3F10.5)") element_symbol, &
1271 particle_set(iatom)%r(1:3)*conv
1274 DO ip = 1, resp_env%npoints_proc
1275 jx = resp_env%fitpoints(1, ip)
1276 jy = resp_env%fitpoints(2, ip)
1277 jz = resp_env%fitpoints(3, ip)
1281 r(3) = p*dh(3, 3) + k*dh(3, 2) + l*dh(3, 1)
1282 r(2) = p*dh(2, 3) + k*dh(2, 2) + l*dh(2, 1)
1283 r(1) = p*dh(1, 3) + k*dh(1, 2) + l*dh(1, 1)
1285 WRITE (unit=output_unit, fmt=
"(A,2X,3F10.5)")
"X", r(1), r(2), r(3)
1289 ALLOCATE (tmp_size(1))
1290 ALLOCATE (tmp_npoints(1))
1293 IF (output_unit > 0)
THEN
1294 my_pos = para_env%mepos
1295 DO i = 1, para_env%num_pe
1296 IF (my_pos == i - 1) cycle
1297 CALL para_env%irecv(msgout=tmp_size, source=i - 1, &
1300 ALLOCATE (tmp_points(3, tmp_size(1)))
1301 CALL para_env%irecv(msgout=tmp_points, source=i - 1, &
1304 CALL para_env%irecv(msgout=tmp_npoints, source=i - 1, &
1307 DO ip = 1, tmp_npoints(1)
1308 jx = tmp_points(1, ip)
1309 jy = tmp_points(2, ip)
1310 jz = tmp_points(3, ip)
1314 r(3) = p*dh(3, 3) + k*dh(3, 2) + l*dh(3, 1)
1315 r(2) = p*dh(2, 3) + k*dh(2, 2) + l*dh(2, 1)
1316 r(1) = p*dh(1, 3) + k*dh(1, 2) + l*dh(1, 1)
1318 WRITE (unit=output_unit, fmt=
"(A,2X,3F10.5)")
"X", r(1), r(2), r(3)
1320 DEALLOCATE (tmp_points)
1323 tmp_size(1) =
SIZE(resp_env%fitpoints, 2)
1325 CALL para_env%isend(msgin=tmp_size, dest=para_env%source, &
1328 CALL para_env%isend(msgin=resp_env%fitpoints, dest=para_env%source, &
1331 tmp_npoints(1) = resp_env%npoints_proc
1332 CALL para_env%isend(msgin=tmp_npoints, dest=para_env%source, &
1337 DEALLOCATE (tmp_size)
1338 DEALLOCATE (tmp_npoints)
1342 "PRINT%COORD_FIT_POINTS")
1344 CALL timestop(handle)
1346 END SUBROUTINE print_fitting_points
1358 SUBROUTINE add_restraints_and_constraints(qs_env, resp_env, rest_section, &
1359 subsys, natom, cons_section, particle_set)
1362 TYPE(resp_type),
POINTER :: resp_env
1365 INTEGER,
INTENT(IN) :: natom
1369 CHARACTER(len=*),
PARAMETER :: routinen =
'add_restraints_and_constraints'
1371 INTEGER :: handle, i, k, m, ncons_v, z
1372 INTEGER,
DIMENSION(:),
POINTER :: atom_list_cons, atom_list_res
1373 LOGICAL :: explicit_coeff
1374 REAL(kind=
dp) :: my_atom_coef(2), strength,
TARGET
1375 REAL(kind=
dp),
DIMENSION(:),
POINTER :: atom_coef
1378 CALL timeset(routinen, handle)
1380 NULLIFY (atom_coef, atom_list_res, atom_list_cons, dft_control)
1382 CALL get_qs_env(qs_env, dft_control=dft_control)
1385 DO i = 1, resp_env%nrest_sec
1388 CALL build_atom_list(rest_section, subsys, atom_list_res, i)
1390 IF (explicit_coeff)
THEN
1392 cpassert(
SIZE(atom_list_res) ==
SIZE(atom_coef))
1394 DO m = 1,
SIZE(atom_list_res)
1395 IF (explicit_coeff)
THEN
1396 DO k = 1,
SIZE(atom_list_res)
1397 resp_env%matrix(atom_list_res(m), atom_list_res(k)) = &
1398 resp_env%matrix(atom_list_res(m), atom_list_res(k)) + &
1399 atom_coef(m)*atom_coef(k)*2.0_dp*strength
1401 resp_env%rhs(atom_list_res(m)) = resp_env%rhs(atom_list_res(m)) + &
1402 2.0_dp*
TARGET*strength*atom_coef(m)
1404 resp_env%matrix(atom_list_res(m), atom_list_res(m)) = &
1405 resp_env%matrix(atom_list_res(m), atom_list_res(m)) + &
1407 resp_env%rhs(atom_list_res(m)) = resp_env%rhs(atom_list_res(m)) + &
1408 2.0_dp*
TARGET*strength
1411 DEALLOCATE (atom_list_res)
1415 IF (resp_env%rheavies)
THEN
1419 resp_env%matrix(i, i) = resp_env%matrix(i, i) + 2.0_dp*resp_env%rheavies_strength
1426 ncons_v = ncons_v + natom
1429 IF (resp_env%use_repeat_method)
THEN
1430 ncons_v = ncons_v + 1
1431 resp_env%matrix(1:natom, ncons_v) = resp_env%sum_vpot(1:natom)
1432 resp_env%matrix(ncons_v, 1:natom) = resp_env%sum_vpot(1:natom)
1433 resp_env%matrix(ncons_v, ncons_v) = 2.0_dp
1434 resp_env%rhs(ncons_v) = resp_env%sum_vhartree
1438 IF (resp_env%itc)
THEN
1439 ncons_v = ncons_v + 1
1440 resp_env%matrix(1:natom, ncons_v) = 1.0_dp
1441 resp_env%matrix(ncons_v, 1:natom) = 1.0_dp
1442 resp_env%rhs(ncons_v) = dft_control%charge
1446 DO i = 1, resp_env%ncons_sec
1447 CALL build_atom_list(cons_section, subsys, atom_list_cons, i)
1448 IF (.NOT. resp_env%equal_charges)
THEN
1449 ncons_v = ncons_v + 1
1452 cpassert(
SIZE(atom_list_cons) ==
SIZE(atom_coef))
1453 DO m = 1,
SIZE(atom_list_cons)
1454 resp_env%matrix(atom_list_cons(m), ncons_v) = atom_coef(m)
1455 resp_env%matrix(ncons_v, atom_list_cons(m)) = atom_coef(m)
1457 resp_env%rhs(ncons_v) =
TARGET
1459 my_atom_coef(1) = 1.0_dp
1460 my_atom_coef(2) = -1.0_dp
1461 DO k = 2,
SIZE(atom_list_cons)
1462 ncons_v = ncons_v + 1
1463 resp_env%matrix(atom_list_cons(1), ncons_v) = my_atom_coef(1)
1464 resp_env%matrix(ncons_v, atom_list_cons(1)) = my_atom_coef(1)
1465 resp_env%matrix(atom_list_cons(k), ncons_v) = my_atom_coef(2)
1466 resp_env%matrix(ncons_v, atom_list_cons(k)) = my_atom_coef(2)
1467 resp_env%rhs(ncons_v) = 0.0_dp
1470 DEALLOCATE (atom_list_cons)
1472 CALL timestop(handle)
1474 END SUBROUTINE add_restraints_and_constraints
1483 SUBROUTINE print_resp_parameter_info(qs_env, resp_env, rep_sys, my_per)
1486 TYPE(resp_type),
POINTER :: resp_env
1487 TYPE(resp_p_type),
DIMENSION(:),
POINTER :: rep_sys
1488 INTEGER,
INTENT(IN) :: my_per
1490 CHARACTER(len=*),
PARAMETER :: routinen =
'print_resp_parameter_info'
1492 CHARACTER(len=2) :: symbol
1493 INTEGER :: handle, i, ikind, kind_number, nkinds, &
1495 REAL(kind=
dp) :: conv, eta_conv
1500 CALL timeset(routinen, handle)
1501 NULLIFY (logger, input, resp_section)
1505 atomic_kind_set=atomic_kind_set)
1510 nkinds =
SIZE(atomic_kind_set)
1517 IF (output_unit > 0)
THEN
1518 WRITE (output_unit,
'(/,1X,A,/)')
"STARTING RESP FIT"
1519 IF (resp_env%use_repeat_method)
THEN
1520 WRITE (output_unit,
'(T3,A)') &
1521 "Fit the variance of the potential (REPEAT method)."
1523 IF (.NOT. resp_env%equal_charges)
THEN
1524 WRITE (output_unit,
'(T3,A,T75,I6)')
"Number of explicit constraints: ", resp_env%ncons_sec
1526 IF (resp_env%itc)
THEN
1527 WRITE (output_unit,
'(T3,A,T75,I6)')
"Number of explicit constraints: ", resp_env%ncons - 1
1529 WRITE (output_unit,
'(T3,A,T75,I6)')
"Number of explicit constraints: ", resp_env%ncons
1532 WRITE (output_unit,
'(T3,A,T75,I6)')
"Number of explicit restraints: ", resp_env%nrest_sec
1533 WRITE (output_unit,
'(T3,A,T80,A)')
"Constrain total charge ", merge(
"T",
"F", resp_env%itc)
1534 WRITE (output_unit,
'(T3,A,T80,A)')
"Restrain heavy atoms ", merge(
"T",
"F", resp_env%rheavies)
1535 IF (resp_env%rheavies)
THEN
1536 WRITE (output_unit,
'(T3,A,T71,F10.6)')
"Heavy atom restraint strength: ", &
1537 resp_env%rheavies_strength
1539 WRITE (output_unit,
'(T3,A,T66,3I5)')
"Stride: ", resp_env%stride
1540 IF (resp_env%molecular_sys)
THEN
1541 WRITE (output_unit,
'(T3,A)') &
1542 "------------------------------------------------------------------------------"
1543 WRITE (output_unit,
'(T3,A)')
"Using sphere sampling"
1544 WRITE (output_unit,
'(T3,A,T46,A,T66,A)') &
1545 "Element",
"RMIN [angstrom]",
"RMAX [angstrom]"
1546 DO ikind = 1, nkinds
1548 kind_number=kind_number, &
1549 element_symbol=symbol)
1550 WRITE (output_unit,
'(T3,A,T51,F10.5,T71,F10.5)') &
1552 resp_env%rmin_kind(kind_number)*conv, &
1553 resp_env%rmax_kind(kind_number)*conv
1556 WRITE (output_unit,
'(T3,A,T51,3F10.5)')
"Box min [angstrom]: ", resp_env%box_low(1:3)*conv
1557 WRITE (output_unit,
'(T3,A,T51,3F10.5)')
"Box max [angstrom]: ", resp_env%box_hi(1:3)*conv
1559 WRITE (output_unit,
'(T3,A)') &
1560 "------------------------------------------------------------------------------"
1562 WRITE (output_unit,
'(T3,A)') &
1563 "------------------------------------------------------------------------------"
1564 WRITE (output_unit,
'(T3,A)')
"Using slab sampling"
1565 WRITE (output_unit,
'(2X,A,F10.5)')
"Index of atoms defining the surface: "
1566 DO i = 1,
SIZE(rep_sys)
1567 IF (i > 1 .AND. all(rep_sys(i)%p_resp%atom_surf_list == rep_sys(1)%p_resp%atom_surf_list))
EXIT
1568 WRITE (output_unit,
'(7X,10I6)') rep_sys(i)%p_resp%atom_surf_list
1570 DO i = 1,
SIZE(rep_sys)
1571 IF (i > 1 .AND. all(rep_sys(i)%p_resp%range_surf == rep_sys(1)%p_resp%range_surf))
EXIT
1572 WRITE (output_unit,
'(T3,A,T61,2F10.5)') &
1573 "Range for sampling above the surface [angstrom]:", &
1574 rep_sys(i)%p_resp%range_surf(1:2)*conv
1576 DO i = 1,
SIZE(rep_sys)
1577 IF (i > 1 .AND. rep_sys(i)%p_resp%length == rep_sys(1)%p_resp%length)
EXIT
1578 WRITE (output_unit,
'(T3,A,T71,F10.5)')
"Length of sampling box above each"// &
1579 " surface atom [angstrom]: ", rep_sys(i)%p_resp%length*conv
1581 WRITE (output_unit,
'(T3,A)') &
1582 "------------------------------------------------------------------------------"
1585 WRITE (output_unit,
'(T3,A,T71,F10.5)')
"Width of Gaussian charge"// &
1586 " distribution [angstrom^-2]: ", eta_conv
1591 "PRINT%PROGRAM_RUN_INFO")
1593 CALL timestop(handle)
1595 END SUBROUTINE print_resp_parameter_info
1604 SUBROUTINE print_resp_charges(qs_env, resp_env, output_runinfo, natom)
1607 TYPE(resp_type),
POINTER :: resp_env
1608 INTEGER,
INTENT(IN) :: output_runinfo, natom
1610 CHARACTER(len=*),
PARAMETER :: routinen =
'print_resp_charges'
1612 CHARACTER(LEN=default_path_length) :: filename
1613 INTEGER :: handle, output_file
1616 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
1619 CALL timeset(routinen, handle)
1621 NULLIFY (particle_set, qs_kind_set, input, logger, resp_section, print_key)
1623 CALL get_qs_env(qs_env, input=input, particle_set=particle_set, &
1624 qs_kind_set=qs_kind_set)
1628 "PRINT%RESP_CHARGES_TO_FILE")
1632 resp_section,
"PRINT%RESP_CHARGES_TO_FILE"), &
1635 "PRINT%RESP_CHARGES_TO_FILE", &
1636 extension=
".resp", &
1637 file_status=
"REPLACE", &
1638 file_action=
"WRITE", &
1639 file_form=
"FORMATTED")
1640 IF (output_file > 0)
THEN
1642 print_key, extension=
".resp", &
1646 IF (output_runinfo > 0)
WRITE (output_runinfo,
'(2X,A,/)')
"PRINTED RESP CHARGES TO FILE"
1650 "PRINT%RESP_CHARGES_TO_FILE")
1656 CALL timestop(handle)
1658 END SUBROUTINE print_resp_charges
1668 SUBROUTINE print_pot_from_resp_charges(qs_env, resp_env, particles, natom, output_runinfo)
1671 TYPE(resp_type),
POINTER :: resp_env
1673 INTEGER,
INTENT(IN) :: natom, output_runinfo
1675 CHARACTER(len=*),
PARAMETER :: routinen =
'print_pot_from_resp_charges'
1677 CHARACTER(LEN=default_path_length) :: my_pos_cube
1678 INTEGER :: handle, ip, jx, jy, jz, unit_nr
1679 LOGICAL :: append_cube, mpi_io
1680 REAL(kind=
dp) :: dvol, normalize_factor, rms, rrms, &
1681 sum_diff, sum_hartree, udvol
1692 CALL timeset(routinen, handle)
1694 NULLIFY (auxbas_pw_pool, logger, pw_env, poisson_env, input, print_key, &
1695 para_env, resp_section, v_hartree_rspace)
1698 para_env=para_env, &
1700 v_hartree_rspace=v_hartree_rspace)
1701 normalize_factor = sqrt((resp_env%eta/
pi)**3)
1704 "PRINT%V_RESP_CUBE")
1708 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
1709 poisson_env=poisson_env)
1711 CALL auxbas_pw_pool%create_pw(rho_resp)
1712 CALL auxbas_pw_pool%create_pw(v_resp_gspace)
1713 CALL auxbas_pw_pool%create_pw(v_resp_rspace)
1717 resp_env%eta, qs_env)
1720 vhartree=v_resp_gspace)
1723 dvol = v_resp_rspace%pw_grid%dvol
1725 CALL pw_scale(v_resp_rspace, -normalize_factor)
1728 IF (resp_env%use_repeat_method)
THEN
1729 v_resp_rspace%array(:, :, :) = v_resp_rspace%array(:, :, :) - resp_env%offset*dvol
1731 CALL v_resp_gspace%release()
1732 CALL rho_resp%release()
1737 CALL auxbas_pw_pool%create_pw(aux_r)
1739 my_pos_cube =
"REWIND"
1740 IF (append_cube)
THEN
1741 my_pos_cube =
"APPEND"
1745 "PRINT%V_RESP_CUBE", &
1746 extension=
".cube", &
1747 file_position=my_pos_cube, &
1750 CALL pw_copy(v_resp_rspace, aux_r)
1752 CALL cp_pw_to_cube(aux_r, unit_nr,
"RESP POTENTIAL", particles=particles, &
1754 "PRINT%V_RESP_CUBE%STRIDE"), &
1757 "PRINT%V_RESP_CUBE", mpi_io=mpi_io)
1758 CALL auxbas_pw_pool%give_back_pw(aux_r)
1763 sum_hartree = 0.0_dp
1766 DO ip = 1, resp_env%npoints_proc
1767 jx = resp_env%fitpoints(1, ip)
1768 jy = resp_env%fitpoints(2, ip)
1769 jz = resp_env%fitpoints(3, ip)
1770 sum_diff = sum_diff + (v_hartree_rspace%array(jx, jy, jz) - &
1771 v_resp_rspace%array(jx, jy, jz))**2
1772 sum_hartree = sum_hartree + v_hartree_rspace%array(jx, jy, jz)**2
1774 CALL para_env%sum(sum_diff)
1775 CALL para_env%sum(sum_hartree)
1776 rms = sqrt(sum_diff/resp_env%npoints)
1777 rrms = sqrt(sum_diff/sum_hartree)
1778 IF (output_runinfo > 0)
THEN
1779 WRITE (output_runinfo,
'(2X,A,T69,ES12.5)')
"Root-mean-square (RMS) "// &
1780 "error of RESP fit:", rms
1781 WRITE (output_runinfo,
'(2X,A,T69,ES12.5,/)')
"Relative root-mean-square "// &
1782 "(RRMS) error of RESP fit:", rrms
1785 CALL v_resp_rspace%release()
1787 CALL timestop(handle)
1789 END SUBROUTINE print_pot_from_resp_charges
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
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
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.
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public golze2015
integer, save, public rappe1992
integer, save, public campana2009
Handles all functions related to the CELL.
integer, parameter, public use_perd_xyz
subroutine, public get_cell(cell, alpha, beta, gamma, deth, orthorhombic, abc, periodic, h, h_inv, symmetry_id, tag)
Get informations about a simulation cell.
integer, parameter, public use_perd_none
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
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)
...
character(len=default_path_length) function, public cp_print_key_generate_filename(logger, print_key, middle_name, extension, my_local)
Utility function that returns a unit number to write the print key. Might open a file with a unique f...
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,...
integer, parameter, public cp_p_file
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
A wrapper around pw_to_cube() which accepts particle_list_type.
subroutine, public cp_pw_to_cube(pw, unit_nr, title, particles, stride, zero_tails, silent, mpi_io)
...
real(kind=dp) function, public cp_unit_from_cp2k(value, unit_str, defaults, power)
converts from the internal cp2k units to the given unit
real(kind=dp) function, public cp_unit_to_cp2k(value, unit_str, defaults, power)
converts to the internal cp2k units to the given unit
sums arrays of real/complex numbers with much reduced round-off as compared to a naive implementation...
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
integer, parameter, public default_path_length
Machine interface based on Fortran 2003 and POSIX.
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
Utility routines for the memory handling.
Interface to the message passing library MPI.
represent a simple array based list of the given type
Define the data structure for the particle information.
Periodic Table related data definitions.
subroutine, public get_ptable_info(symbol, number, amass, ielement, covalent_radius, metallic_radius, vdw_radius, found)
Pass information about the kind given the element symbol.
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 ...
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
subroutine, public calculate_rho_resp_single(rho_gb, qs_env, eta, iatom_in)
collocate a single Gaussian on the grid for periodic RESP fitting
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.
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, harris_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, eeq, rhs)
Set the QUICKSTEP environment.
Define the quickstep kind type and their sub types.
provides a resp fit for gas phase systems
subroutine, public resp_fit(qs_env)
performs resp fit and generates RESP charges
types that represent a quickstep subsys
subroutine, public qs_subsys_get(subsys, atomic_kinds, atomic_kind_set, particles, particle_set, local_particles, molecules, molecule_set, molecule_kinds, molecule_kind_set, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, natom, nparticle, ncore, nshell, nkind, atprop, virial, results, cell, cell_ref, use_ref_cell, energy, force, qs_kind_set, cp_subsys, nelectron_total, nelectron_spin)
...
provides a table for UFF vdW radii: Rappe et al. J. Am. Chem. Soc. 114, 10024 (1992)
pure subroutine, public get_uff_vdw_radius(z, radius, found)
get UFF vdW radius for a given element
Provides all information about an atomic kind.
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
represent a list of objects
contained for different pw related things
environment for the poisson solver
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Provides all information about a quickstep kind.