22 #include "./base/base_uses.f90"
25 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_force_types'
29 REAL(KIND=
dp),
DIMENSION(:, :),
POINTER :: all_potential, &
53 END TYPE qs_force_type
55 PUBLIC :: qs_force_type
80 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
81 INTEGER,
DIMENSION(:),
INTENT(IN) :: natom_of_kind
83 INTEGER :: ikind, n, nkind
87 nkind =
SIZE(natom_of_kind)
92 n = natom_of_kind(ikind)
93 ALLOCATE (
qs_force(ikind)%all_potential(3, n))
94 ALLOCATE (
qs_force(ikind)%core_overlap(3, n))
95 ALLOCATE (
qs_force(ikind)%gth_ppl(3, n))
96 ALLOCATE (
qs_force(ikind)%gth_nlcc(3, n))
97 ALLOCATE (
qs_force(ikind)%gth_ppnl(3, n))
98 ALLOCATE (
qs_force(ikind)%kinetic(3, n))
99 ALLOCATE (
qs_force(ikind)%overlap(3, n))
100 ALLOCATE (
qs_force(ikind)%overlap_admm(3, n))
101 ALLOCATE (
qs_force(ikind)%rho_core(3, n))
102 ALLOCATE (
qs_force(ikind)%rho_elec(3, n))
103 ALLOCATE (
qs_force(ikind)%rho_lri_elec(3, n))
104 ALLOCATE (
qs_force(ikind)%vhxc_atom(3, n))
105 ALLOCATE (
qs_force(ikind)%g0s_Vh_elec(3, n))
106 ALLOCATE (
qs_force(ikind)%repulsive(3, n))
107 ALLOCATE (
qs_force(ikind)%dispersion(3, n))
108 ALLOCATE (
qs_force(ikind)%gcp(3, n))
109 ALLOCATE (
qs_force(ikind)%other(3, n))
110 ALLOCATE (
qs_force(ikind)%ch_pulay(3, n))
111 ALLOCATE (
qs_force(ikind)%ehrenfest(3, n))
112 ALLOCATE (
qs_force(ikind)%efield(3, n))
113 ALLOCATE (
qs_force(ikind)%eev(3, n))
116 ALLOCATE (
qs_force(ikind)%fock_4c(3, n))
117 ALLOCATE (
qs_force(ikind)%mp2_non_sep(3, n))
118 ALLOCATE (
qs_force(ikind)%total(3, n))
132 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
134 INTEGER :: ikind, nkind
142 IF (
ASSOCIATED(
qs_force(ikind)%all_potential))
THEN
143 DEALLOCATE (
qs_force(ikind)%all_potential)
146 IF (
ASSOCIATED(
qs_force(ikind)%core_overlap))
THEN
147 DEALLOCATE (
qs_force(ikind)%core_overlap)
150 IF (
ASSOCIATED(
qs_force(ikind)%gth_ppl))
THEN
151 DEALLOCATE (
qs_force(ikind)%gth_ppl)
154 IF (
ASSOCIATED(
qs_force(ikind)%gth_nlcc))
THEN
155 DEALLOCATE (
qs_force(ikind)%gth_nlcc)
158 IF (
ASSOCIATED(
qs_force(ikind)%gth_ppnl))
THEN
159 DEALLOCATE (
qs_force(ikind)%gth_ppnl)
162 IF (
ASSOCIATED(
qs_force(ikind)%kinetic))
THEN
163 DEALLOCATE (
qs_force(ikind)%kinetic)
166 IF (
ASSOCIATED(
qs_force(ikind)%overlap))
THEN
167 DEALLOCATE (
qs_force(ikind)%overlap)
170 IF (
ASSOCIATED(
qs_force(ikind)%overlap_admm))
THEN
171 DEALLOCATE (
qs_force(ikind)%overlap_admm)
174 IF (
ASSOCIATED(
qs_force(ikind)%rho_core))
THEN
175 DEALLOCATE (
qs_force(ikind)%rho_core)
178 IF (
ASSOCIATED(
qs_force(ikind)%rho_elec))
THEN
179 DEALLOCATE (
qs_force(ikind)%rho_elec)
181 IF (
ASSOCIATED(
qs_force(ikind)%rho_lri_elec))
THEN
182 DEALLOCATE (
qs_force(ikind)%rho_lri_elec)
185 IF (
ASSOCIATED(
qs_force(ikind)%vhxc_atom))
THEN
186 DEALLOCATE (
qs_force(ikind)%vhxc_atom)
189 IF (
ASSOCIATED(
qs_force(ikind)%g0s_Vh_elec))
THEN
190 DEALLOCATE (
qs_force(ikind)%g0s_Vh_elec)
193 IF (
ASSOCIATED(
qs_force(ikind)%repulsive))
THEN
194 DEALLOCATE (
qs_force(ikind)%repulsive)
197 IF (
ASSOCIATED(
qs_force(ikind)%dispersion))
THEN
198 DEALLOCATE (
qs_force(ikind)%dispersion)
201 IF (
ASSOCIATED(
qs_force(ikind)%gcp))
THEN
205 IF (
ASSOCIATED(
qs_force(ikind)%other))
THEN
209 IF (
ASSOCIATED(
qs_force(ikind)%total))
THEN
213 IF (
ASSOCIATED(
qs_force(ikind)%ch_pulay))
THEN
214 DEALLOCATE (
qs_force(ikind)%ch_pulay)
217 IF (
ASSOCIATED(
qs_force(ikind)%fock_4c))
THEN
218 DEALLOCATE (
qs_force(ikind)%fock_4c)
221 IF (
ASSOCIATED(
qs_force(ikind)%mp2_non_sep))
THEN
222 DEALLOCATE (
qs_force(ikind)%mp2_non_sep)
225 IF (
ASSOCIATED(
qs_force(ikind)%ehrenfest))
THEN
226 DEALLOCATE (
qs_force(ikind)%ehrenfest)
229 IF (
ASSOCIATED(
qs_force(ikind)%efield))
THEN
233 IF (
ASSOCIATED(
qs_force(ikind)%eev))
THEN
251 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
258 qs_force(ikind)%all_potential(:, :) = 0.0_dp
259 qs_force(ikind)%core_overlap(:, :) = 0.0_dp
260 qs_force(ikind)%gth_ppl(:, :) = 0.0_dp
261 qs_force(ikind)%gth_nlcc(:, :) = 0.0_dp
262 qs_force(ikind)%gth_ppnl(:, :) = 0.0_dp
263 qs_force(ikind)%kinetic(:, :) = 0.0_dp
264 qs_force(ikind)%overlap(:, :) = 0.0_dp
265 qs_force(ikind)%overlap_admm(:, :) = 0.0_dp
266 qs_force(ikind)%rho_core(:, :) = 0.0_dp
267 qs_force(ikind)%rho_elec(:, :) = 0.0_dp
268 qs_force(ikind)%rho_lri_elec(:, :) = 0.0_dp
269 qs_force(ikind)%vhxc_atom(:, :) = 0.0_dp
270 qs_force(ikind)%g0s_Vh_elec(:, :) = 0.0_dp
271 qs_force(ikind)%repulsive(:, :) = 0.0_dp
272 qs_force(ikind)%dispersion(:, :) = 0.0_dp
274 qs_force(ikind)%other(:, :) = 0.0_dp
275 qs_force(ikind)%fock_4c(:, :) = 0.0_dp
276 qs_force(ikind)%ehrenfest(:, :) = 0.0_dp
277 qs_force(ikind)%efield(:, :) = 0.0_dp
279 qs_force(ikind)%mp2_non_sep(:, :) = 0.0_dp
280 qs_force(ikind)%total(:, :) = 0.0_dp
293 TYPE(qs_force_type),
DIMENSION(:),
POINTER :: qs_force_out, qs_force_in
297 cpassert(
ASSOCIATED(qs_force_out))
298 cpassert(
ASSOCIATED(qs_force_in))
300 DO ikind = 1,
SIZE(qs_force_out)
301 qs_force_out(ikind)%all_potential(:, :) = qs_force_out(ikind)%all_potential(:, :) + &
302 qs_force_in(ikind)%all_potential(:, :)
303 qs_force_out(ikind)%core_overlap(:, :) = qs_force_out(ikind)%core_overlap(:, :) + &
304 qs_force_in(ikind)%core_overlap(:, :)
305 qs_force_out(ikind)%gth_ppl(:, :) = qs_force_out(ikind)%gth_ppl(:, :) + &
306 qs_force_in(ikind)%gth_ppl(:, :)
307 qs_force_out(ikind)%gth_nlcc(:, :) = qs_force_out(ikind)%gth_nlcc(:, :) + &
308 qs_force_in(ikind)%gth_nlcc(:, :)
309 qs_force_out(ikind)%gth_ppnl(:, :) = qs_force_out(ikind)%gth_ppnl(:, :) + &
310 qs_force_in(ikind)%gth_ppnl(:, :)
311 qs_force_out(ikind)%kinetic(:, :) = qs_force_out(ikind)%kinetic(:, :) + &
312 qs_force_in(ikind)%kinetic(:, :)
313 qs_force_out(ikind)%overlap(:, :) = qs_force_out(ikind)%overlap(:, :) + &
314 qs_force_in(ikind)%overlap(:, :)
315 qs_force_out(ikind)%overlap_admm(:, :) = qs_force_out(ikind)%overlap_admm(:, :) + &
316 qs_force_in(ikind)%overlap_admm(:, :)
317 qs_force_out(ikind)%rho_core(:, :) = qs_force_out(ikind)%rho_core(:, :) + &
318 qs_force_in(ikind)%rho_core(:, :)
319 qs_force_out(ikind)%rho_elec(:, :) = qs_force_out(ikind)%rho_elec(:, :) + &
320 qs_force_in(ikind)%rho_elec(:, :)
321 qs_force_out(ikind)%rho_lri_elec(:, :) = qs_force_out(ikind)%rho_lri_elec(:, :) + &
322 qs_force_in(ikind)%rho_lri_elec(:, :)
323 qs_force_out(ikind)%vhxc_atom(:, :) = qs_force_out(ikind)%vhxc_atom(:, :) + &
324 qs_force_in(ikind)%vhxc_atom(:, :)
325 qs_force_out(ikind)%g0s_Vh_elec(:, :) = qs_force_out(ikind)%g0s_Vh_elec(:, :) + &
326 qs_force_in(ikind)%g0s_Vh_elec(:, :)
327 qs_force_out(ikind)%repulsive(:, :) = qs_force_out(ikind)%repulsive(:, :) + &
328 qs_force_in(ikind)%repulsive(:, :)
329 qs_force_out(ikind)%dispersion(:, :) = qs_force_out(ikind)%dispersion(:, :) + &
330 qs_force_in(ikind)%dispersion(:, :)
331 qs_force_out(ikind)%gcp(:, :) = qs_force_out(ikind)%gcp(:, :) + &
332 qs_force_in(ikind)%gcp(:, :)
333 qs_force_out(ikind)%other(:, :) = qs_force_out(ikind)%other(:, :) + &
334 qs_force_in(ikind)%other(:, :)
335 qs_force_out(ikind)%fock_4c(:, :) = qs_force_out(ikind)%fock_4c(:, :) + &
336 qs_force_in(ikind)%fock_4c(:, :)
337 qs_force_out(ikind)%ehrenfest(:, :) = qs_force_out(ikind)%ehrenfest(:, :) + &
338 qs_force_in(ikind)%ehrenfest(:, :)
339 qs_force_out(ikind)%efield(:, :) = qs_force_out(ikind)%efield(:, :) + &
340 qs_force_in(ikind)%efield(:, :)
341 qs_force_out(ikind)%eev(:, :) = qs_force_out(ikind)%eev(:, :) + &
342 qs_force_in(ikind)%eev(:, :)
343 qs_force_out(ikind)%mp2_non_sep(:, :) = qs_force_out(ikind)%mp2_non_sep(:, :) + &
344 qs_force_in(ikind)%mp2_non_sep(:, :)
345 qs_force_out(ikind)%total(:, :) = qs_force_out(ikind)%total(:, :) + &
346 qs_force_in(ikind)%total(:, :)
361 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
362 TYPE(mp_para_env_type),
POINTER :: para_env
368 CALL para_env%sum(
qs_force(ikind)%overlap)
369 CALL para_env%sum(
qs_force(ikind)%overlap_admm)
370 CALL para_env%sum(
qs_force(ikind)%kinetic)
371 CALL para_env%sum(
qs_force(ikind)%gth_ppl)
372 CALL para_env%sum(
qs_force(ikind)%gth_nlcc)
373 CALL para_env%sum(
qs_force(ikind)%gth_ppnl)
374 CALL para_env%sum(
qs_force(ikind)%all_potential)
375 CALL para_env%sum(
qs_force(ikind)%core_overlap)
376 CALL para_env%sum(
qs_force(ikind)%rho_core)
377 CALL para_env%sum(
qs_force(ikind)%rho_elec)
378 CALL para_env%sum(
qs_force(ikind)%rho_lri_elec)
379 CALL para_env%sum(
qs_force(ikind)%vhxc_atom)
380 CALL para_env%sum(
qs_force(ikind)%g0s_Vh_elec)
381 CALL para_env%sum(
qs_force(ikind)%fock_4c)
382 CALL para_env%sum(
qs_force(ikind)%mp2_non_sep)
383 CALL para_env%sum(
qs_force(ikind)%repulsive)
384 CALL para_env%sum(
qs_force(ikind)%dispersion)
385 CALL para_env%sum(
qs_force(ikind)%gcp)
386 CALL para_env%sum(
qs_force(ikind)%ehrenfest)
389 qs_force(ikind)%core_overlap(:, :) + &
393 qs_force(ikind)%all_potential(:, :) + &
396 qs_force(ikind)%overlap_admm(:, :) + &
399 qs_force(ikind)%rho_lri_elec(:, :) + &
401 qs_force(ikind)%g0s_Vh_elec(:, :) + &
403 qs_force(ikind)%mp2_non_sep(:, :) + &
405 qs_force(ikind)%dispersion(:, :) + &
426 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: force
427 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
428 CHARACTER(LEN=*),
INTENT(IN) :: forcetype
429 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
431 INTEGER :: ia, iatom, ikind, natom_kind
432 TYPE(atomic_kind_type),
POINTER :: atomic_kind
438 SELECT CASE (forcetype)
439 CASE (
"overlap_admm")
440 DO ikind = 1,
SIZE(atomic_kind_set, 1)
441 atomic_kind => atomic_kind_set(ikind)
443 DO ia = 1, natom_kind
444 iatom = atomic_kind%atom_list(ia)
445 qs_force(ikind)%overlap_admm(:, ia) =
qs_force(ikind)%overlap_admm(:, ia) + force(:, iatom)
466 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: force
467 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
468 CHARACTER(LEN=*),
INTENT(IN) :: forcetype
469 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
471 INTEGER :: ia, iatom, ikind, natom_kind
472 TYPE(atomic_kind_type),
POINTER :: atomic_kind
476 SELECT CASE (forcetype)
478 DO ikind = 1,
SIZE(atomic_kind_set, 1)
479 atomic_kind => atomic_kind_set(ikind)
481 DO ia = 1, natom_kind
482 iatom = atomic_kind%atom_list(ia)
483 qs_force(ikind)%dispersion(:, ia) = force(:, iatom)
504 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(INOUT) :: force
505 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
506 CHARACTER(LEN=*),
INTENT(IN) :: forcetype
507 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
509 INTEGER :: ia, iatom, ikind, natom_kind
510 TYPE(atomic_kind_type),
POINTER :: atomic_kind
514 SELECT CASE (forcetype)
516 DO ikind = 1,
SIZE(atomic_kind_set, 1)
517 atomic_kind => atomic_kind_set(ikind)
519 DO ia = 1, natom_kind
520 iatom = atomic_kind%atom_list(ia)
521 force(:, iatom) =
qs_force(ikind)%dispersion(:, ia)
541 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(INOUT) :: force
542 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
543 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
545 INTEGER :: ia, iatom, ikind, natom_kind
546 TYPE(atomic_kind_type),
POINTER :: atomic_kind
551 DO ikind = 1,
SIZE(atomic_kind_set, 1)
552 atomic_kind => atomic_kind_set(ikind)
554 DO ia = 1, natom_kind
555 iatom = atomic_kind%atom_list(ia)
556 force(:, iatom) =
qs_force(ikind)%core_overlap(:, ia) + &
560 qs_force(ikind)%all_potential(:, ia) + &
563 qs_force(ikind)%overlap_admm(:, ia) + &
566 qs_force(ikind)%rho_lri_elec(:, ia) + &
567 qs_force(ikind)%vhxc_atom(:, ia) + &
568 qs_force(ikind)%g0s_Vh_elec(:, ia) + &
570 qs_force(ikind)%mp2_non_sep(:, ia) + &
571 qs_force(ikind)%repulsive(:, ia) + &
572 qs_force(ikind)%dispersion(:, ia) + &
574 qs_force(ikind)%ehrenfest(:, ia) + &
594 TYPE(qs_force_type),
DIMENSION(:),
POINTER ::
qs_force
595 INTEGER,
INTENT(IN),
OPTIONAL :: ikind, iatom, iunit
597 CHARACTER(LEN=35) :: fmtstr2
598 CHARACTER(LEN=48) :: fmtstr1
599 INTEGER :: iounit, jatom, jkind
600 REAL(kind=
dp),
DIMENSION(3) :: total
601 TYPE(cp_logger_type),
POINTER :: logger
603 IF (
PRESENT(iunit))
THEN
610 IF (
PRESENT(ikind))
THEN
615 IF (
PRESENT(iatom))
THEN
623 fmtstr1 =
"(/,T2,A,/,T3,A,T11,A,T23,A,T40,A1,2(17X,A1))"
624 fmtstr2 =
"((T2,I5,4X,I4,T18,A,T34,3F18.12))"
626 WRITE (unit=iounit, fmt=fmtstr1) &
627 "FORCES [a.u.]",
"Atom",
"Kind",
"Component",
"X",
"Y",
"Z"
629 total(1:3) =
qs_force(jkind)%overlap(1:3, jatom) &
630 +
qs_force(jkind)%overlap_admm(1:3, jatom) &
631 +
qs_force(jkind)%kinetic(1:3, jatom) &
632 +
qs_force(jkind)%gth_ppl(1:3, jatom) &
633 +
qs_force(jkind)%gth_ppnl(1:3, jatom) &
634 +
qs_force(jkind)%core_overlap(1:3, jatom) &
635 +
qs_force(jkind)%rho_core(1:3, jatom) &
636 +
qs_force(jkind)%rho_elec(1:3, jatom) &
637 +
qs_force(jkind)%dispersion(1:3, jatom) &
638 +
qs_force(jkind)%fock_4c(1:3, jatom) &
639 +
qs_force(jkind)%mp2_non_sep(1:3, jatom)
641 WRITE (unit=iounit, fmt=fmtstr2) &
642 jatom, jkind,
" overlap",
qs_force(jkind)%overlap(1:3, jatom), &
643 jatom, jkind,
" overlap_admm",
qs_force(jkind)%overlap_admm(1:3, jatom), &
644 jatom, jkind,
" kinetic",
qs_force(jkind)%kinetic(1:3, jatom), &
645 jatom, jkind,
" gth_ppl",
qs_force(jkind)%gth_ppl(1:3, jatom), &
646 jatom, jkind,
" gth_ppnl",
qs_force(jkind)%gth_ppnl(1:3, jatom), &
647 jatom, jkind,
" core_overlap",
qs_force(jkind)%core_overlap(1:3, jatom), &
648 jatom, jkind,
" rho_core",
qs_force(jkind)%rho_core(1:3, jatom), &
649 jatom, jkind,
" rho_elec",
qs_force(jkind)%rho_elec(1:3, jatom), &
650 jatom, jkind,
" dispersion",
qs_force(jkind)%dispersion(1:3, jatom), &
651 jatom, jkind,
" fock_4c",
qs_force(jkind)%fock_4c(1:3, jatom), &
652 jatom, jkind,
" mp2_non_sep",
qs_force(jkind)%mp2_non_sep(1:3, jatom), &
653 jatom, jkind,
" total", total(1:3)
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.
various routines to log and control the output. The idea is that decisions about where to log should ...
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Defines the basic variable types.
integer, parameter, public dp
Interface to the message passing library MPI.
subroutine, public sum_qs_force(qs_force_out, qs_force_in)
Sum up two qs_force entities qs_force_out = qs_force_out + qs_force_in.
subroutine, public replicate_qs_force(qs_force, para_env)
Replicate and sum up the force.
subroutine, public deallocate_qs_force(qs_force)
Deallocate a Quickstep force data structure.
subroutine, public zero_qs_force(qs_force)
Initialize a Quickstep force data structure.
subroutine, public add_qs_force(force, qs_force, forcetype, atomic_kind_set)
Add force to a force_type variable.
subroutine, public allocate_qs_force(qs_force, natom_of_kind)
Allocate a Quickstep force data structure.
subroutine, public get_qs_force(force, qs_force, forcetype, atomic_kind_set)
Get force from a force_type variable.
subroutine, public put_qs_force(force, qs_force, forcetype, atomic_kind_set)
Put force to a force_type variable.
subroutine, public total_qs_force(force, qs_force, atomic_kind_set)
Get current total force.
subroutine, public write_forces_debug(qs_force, ikind, iatom, iunit)
Write a Quickstep force data for 1 atom.
Quickstep force driver routine.