(git:374b731)
Loading...
Searching...
No Matches
qs_force_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \par History
10!> Add CP2K error reporting, new add_force routine [07.2014,JGH]
11!> \author MK (03.06.2002)
12! **************************************************************************************************
13MODULE qs_force_types
14
15 USE atomic_kind_types, ONLY: atomic_kind_type,&
16 get_atomic_kind
17 USE cp_log_handling, ONLY: cp_get_default_logger,&
18 cp_logger_get_default_io_unit,&
19 cp_logger_type
20 USE kinds, ONLY: dp
21 USE message_passing, ONLY: mp_para_env_type
22#include "./base/base_uses.f90"
23
24 IMPLICIT NONE
25 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_force_types'
26 PRIVATE
27
28 TYPE qs_force_type
29 REAL(kind=dp), DIMENSION(:, :), POINTER :: all_potential, &
30 core_overlap, &
31 gth_ppl, &
32 gth_nlcc, &
33 gth_ppnl, &
34 kinetic, &
35 overlap, &
36 overlap_admm, &
37 rho_core, &
38 rho_elec, &
39 rho_lri_elec, &
40 vhxc_atom, &
41 g0s_vh_elec, &
42 repulsive, &
43 dispersion, &
44 gcp, &
45 other, &
46 ch_pulay, &
47 fock_4c, &
48 ehrenfest, &
49 efield, &
50 eev, &
51 mp2_non_sep, &
52 total
53 END TYPE qs_force_type
54
55 PUBLIC :: qs_force_type
56
57 PUBLIC :: allocate_qs_force, &
58 add_qs_force, &
59 deallocate_qs_force, &
60 replicate_qs_force, &
61 sum_qs_force, &
62 get_qs_force, &
63 put_qs_force, &
64 total_qs_force, &
65 zero_qs_force, &
66 write_forces_debug
67
68CONTAINS
69
70! **************************************************************************************************
71!> \brief Allocate a Quickstep force data structure.
72!> \param qs_force ...
73!> \param natom_of_kind ...
74!> \date 05.06.2002
75!> \author MK
76!> \version 1.0
77! **************************************************************************************************
78 SUBROUTINE allocate_qs_force(qs_force, natom_of_kind)
79
80 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
81 INTEGER, DIMENSION(:), INTENT(IN) :: natom_of_kind
82
83 INTEGER :: ikind, n, nkind
84
85 IF (ASSOCIATED(qs_force)) CALL deallocate_qs_force(qs_force)
86
87 nkind = SIZE(natom_of_kind)
88
89 ALLOCATE (qs_force(nkind))
90
91 DO ikind = 1, nkind
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))
114 ! Always initialize ch_pulay to zero..
115 qs_force(ikind)%ch_pulay = 0.0_dp
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))
119 END DO
120
121 END SUBROUTINE allocate_qs_force
122
123! **************************************************************************************************
124!> \brief Deallocate a Quickstep force data structure.
125!> \param qs_force ...
126!> \date 05.06.2002
127!> \author MK
128!> \version 1.0
129! **************************************************************************************************
130 SUBROUTINE deallocate_qs_force(qs_force)
131
132 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
133
134 INTEGER :: ikind, nkind
135
136 cpassert(ASSOCIATED(qs_force))
137
138 nkind = SIZE(qs_force)
139
140 DO ikind = 1, nkind
141
142 IF (ASSOCIATED(qs_force(ikind)%all_potential)) THEN
143 DEALLOCATE (qs_force(ikind)%all_potential)
144 END IF
145
146 IF (ASSOCIATED(qs_force(ikind)%core_overlap)) THEN
147 DEALLOCATE (qs_force(ikind)%core_overlap)
148 END IF
149
150 IF (ASSOCIATED(qs_force(ikind)%gth_ppl)) THEN
151 DEALLOCATE (qs_force(ikind)%gth_ppl)
152 END IF
153
154 IF (ASSOCIATED(qs_force(ikind)%gth_nlcc)) THEN
155 DEALLOCATE (qs_force(ikind)%gth_nlcc)
156 END IF
157
158 IF (ASSOCIATED(qs_force(ikind)%gth_ppnl)) THEN
159 DEALLOCATE (qs_force(ikind)%gth_ppnl)
160 END IF
161
162 IF (ASSOCIATED(qs_force(ikind)%kinetic)) THEN
163 DEALLOCATE (qs_force(ikind)%kinetic)
164 END IF
165
166 IF (ASSOCIATED(qs_force(ikind)%overlap)) THEN
167 DEALLOCATE (qs_force(ikind)%overlap)
168 END IF
169
170 IF (ASSOCIATED(qs_force(ikind)%overlap_admm)) THEN
171 DEALLOCATE (qs_force(ikind)%overlap_admm)
172 END IF
173
174 IF (ASSOCIATED(qs_force(ikind)%rho_core)) THEN
175 DEALLOCATE (qs_force(ikind)%rho_core)
176 END IF
177
178 IF (ASSOCIATED(qs_force(ikind)%rho_elec)) THEN
179 DEALLOCATE (qs_force(ikind)%rho_elec)
180 END IF
181 IF (ASSOCIATED(qs_force(ikind)%rho_lri_elec)) THEN
182 DEALLOCATE (qs_force(ikind)%rho_lri_elec)
183 END IF
184
185 IF (ASSOCIATED(qs_force(ikind)%vhxc_atom)) THEN
186 DEALLOCATE (qs_force(ikind)%vhxc_atom)
187 END IF
188
189 IF (ASSOCIATED(qs_force(ikind)%g0s_Vh_elec)) THEN
190 DEALLOCATE (qs_force(ikind)%g0s_Vh_elec)
191 END IF
192
193 IF (ASSOCIATED(qs_force(ikind)%repulsive)) THEN
194 DEALLOCATE (qs_force(ikind)%repulsive)
195 END IF
196
197 IF (ASSOCIATED(qs_force(ikind)%dispersion)) THEN
198 DEALLOCATE (qs_force(ikind)%dispersion)
199 END IF
200
201 IF (ASSOCIATED(qs_force(ikind)%gcp)) THEN
202 DEALLOCATE (qs_force(ikind)%gcp)
203 END IF
204
205 IF (ASSOCIATED(qs_force(ikind)%other)) THEN
206 DEALLOCATE (qs_force(ikind)%other)
207 END IF
208
209 IF (ASSOCIATED(qs_force(ikind)%total)) THEN
210 DEALLOCATE (qs_force(ikind)%total)
211 END IF
212
213 IF (ASSOCIATED(qs_force(ikind)%ch_pulay)) THEN
214 DEALLOCATE (qs_force(ikind)%ch_pulay)
215 END IF
216
217 IF (ASSOCIATED(qs_force(ikind)%fock_4c)) THEN
218 DEALLOCATE (qs_force(ikind)%fock_4c)
219 END IF
220
221 IF (ASSOCIATED(qs_force(ikind)%mp2_non_sep)) THEN
222 DEALLOCATE (qs_force(ikind)%mp2_non_sep)
223 END IF
224
225 IF (ASSOCIATED(qs_force(ikind)%ehrenfest)) THEN
226 DEALLOCATE (qs_force(ikind)%ehrenfest)
227 END IF
228
229 IF (ASSOCIATED(qs_force(ikind)%efield)) THEN
230 DEALLOCATE (qs_force(ikind)%efield)
231 END IF
232
233 IF (ASSOCIATED(qs_force(ikind)%eev)) THEN
234 DEALLOCATE (qs_force(ikind)%eev)
235 END IF
236 END DO
237
238 DEALLOCATE (qs_force)
239
240 END SUBROUTINE deallocate_qs_force
241
242! **************************************************************************************************
243!> \brief Initialize a Quickstep force data structure.
244!> \param qs_force ...
245!> \date 15.07.2002
246!> \author MK
247!> \version 1.0
248! **************************************************************************************************
249 SUBROUTINE zero_qs_force(qs_force)
250
251 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
252
253 INTEGER :: ikind
254
255 cpassert(ASSOCIATED(qs_force))
256
257 DO ikind = 1, SIZE(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
273 qs_force(ikind)%gcp(:, :) = 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
278 qs_force(ikind)%eev(:, :) = 0.0_dp
279 qs_force(ikind)%mp2_non_sep(:, :) = 0.0_dp
280 qs_force(ikind)%total(:, :) = 0.0_dp
281 END DO
282
283 END SUBROUTINE zero_qs_force
284
285! **************************************************************************************************
286!> \brief Sum up two qs_force entities qs_force_out = qs_force_out + qs_force_in
287!> \param qs_force_out ...
288!> \param qs_force_in ...
289!> \author JGH
290! **************************************************************************************************
291 SUBROUTINE sum_qs_force(qs_force_out, qs_force_in)
292
293 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force_out, qs_force_in
294
295 INTEGER :: ikind
296
297 cpassert(ASSOCIATED(qs_force_out))
298 cpassert(ASSOCIATED(qs_force_in))
299
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(:, :)
347 END DO
348
349 END SUBROUTINE sum_qs_force
350
351! **************************************************************************************************
352!> \brief Replicate and sum up the force
353!> \param qs_force ...
354!> \param para_env ...
355!> \date 25.05.2016
356!> \author JHU
357!> \version 1.0
358! **************************************************************************************************
359 SUBROUTINE replicate_qs_force(qs_force, para_env)
360
361 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
362 TYPE(mp_para_env_type), POINTER :: para_env
363
364 INTEGER :: ikind
365
366 ! *** replicate forces ***
367 DO ikind = 1, SIZE(qs_force)
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)
387
388 qs_force(ikind)%total(:, :) = qs_force(ikind)%total(:, :) + &
389 qs_force(ikind)%core_overlap(:, :) + &
390 qs_force(ikind)%gth_ppl(:, :) + &
391 qs_force(ikind)%gth_nlcc(:, :) + &
392 qs_force(ikind)%gth_ppnl(:, :) + &
393 qs_force(ikind)%all_potential(:, :) + &
394 qs_force(ikind)%kinetic(:, :) + &
395 qs_force(ikind)%overlap(:, :) + &
396 qs_force(ikind)%overlap_admm(:, :) + &
397 qs_force(ikind)%rho_core(:, :) + &
398 qs_force(ikind)%rho_elec(:, :) + &
399 qs_force(ikind)%rho_lri_elec(:, :) + &
400 qs_force(ikind)%vhxc_atom(:, :) + &
401 qs_force(ikind)%g0s_Vh_elec(:, :) + &
402 qs_force(ikind)%fock_4c(:, :) + &
403 qs_force(ikind)%mp2_non_sep(:, :) + &
404 qs_force(ikind)%repulsive(:, :) + &
405 qs_force(ikind)%dispersion(:, :) + &
406 qs_force(ikind)%gcp(:, :) + &
407 qs_force(ikind)%ehrenfest(:, :) + &
408 qs_force(ikind)%efield(:, :) + &
409 qs_force(ikind)%eev(:, :)
410 END DO
411
412 END SUBROUTINE replicate_qs_force
413
414! **************************************************************************************************
415!> \brief Add force to a force_type variable.
416!> \param force Input force, dimension (3,natom)
417!> \param qs_force The force type variable to be used
418!> \param forcetype ...
419!> \param atomic_kind_set ...
420!> \par History
421!> 07.2014 JGH
422!> \author JGH
423! **************************************************************************************************
424 SUBROUTINE add_qs_force(force, qs_force, forcetype, atomic_kind_set)
425
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
430
431 INTEGER :: ia, iatom, ikind, natom_kind
432 TYPE(atomic_kind_type), POINTER :: atomic_kind
433
434! ------------------------------------------------------------------------
435
436 cpassert(ASSOCIATED(qs_force))
437
438 SELECT CASE (forcetype)
439 CASE ("overlap_admm")
440 DO ikind = 1, SIZE(atomic_kind_set, 1)
441 atomic_kind => atomic_kind_set(ikind)
442 CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind)
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)
446 END DO
447 END DO
448 CASE DEFAULT
449 cpabort("")
450 END SELECT
451
452 END SUBROUTINE add_qs_force
453
454! **************************************************************************************************
455!> \brief Put force to a force_type variable.
456!> \param force Input force, dimension (3,natom)
457!> \param qs_force The force type variable to be used
458!> \param forcetype ...
459!> \param atomic_kind_set ...
460!> \par History
461!> 09.2019 JGH
462!> \author JGH
463! **************************************************************************************************
464 SUBROUTINE put_qs_force(force, qs_force, forcetype, atomic_kind_set)
465
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
470
471 INTEGER :: ia, iatom, ikind, natom_kind
472 TYPE(atomic_kind_type), POINTER :: atomic_kind
473
474! ------------------------------------------------------------------------
475
476 SELECT CASE (forcetype)
477 CASE ("dispersion")
478 DO ikind = 1, SIZE(atomic_kind_set, 1)
479 atomic_kind => atomic_kind_set(ikind)
480 CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind)
481 DO ia = 1, natom_kind
482 iatom = atomic_kind%atom_list(ia)
483 qs_force(ikind)%dispersion(:, ia) = force(:, iatom)
484 END DO
485 END DO
486 CASE DEFAULT
487 cpabort("")
488 END SELECT
489
490 END SUBROUTINE put_qs_force
491
492! **************************************************************************************************
493!> \brief Get force from a force_type variable.
494!> \param force Input force, dimension (3,natom)
495!> \param qs_force The force type variable to be used
496!> \param forcetype ...
497!> \param atomic_kind_set ...
498!> \par History
499!> 09.2019 JGH
500!> \author JGH
501! **************************************************************************************************
502 SUBROUTINE get_qs_force(force, qs_force, forcetype, atomic_kind_set)
503
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
508
509 INTEGER :: ia, iatom, ikind, natom_kind
510 TYPE(atomic_kind_type), POINTER :: atomic_kind
511
512! ------------------------------------------------------------------------
513
514 SELECT CASE (forcetype)
515 CASE ("dispersion")
516 DO ikind = 1, SIZE(atomic_kind_set, 1)
517 atomic_kind => atomic_kind_set(ikind)
518 CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind)
519 DO ia = 1, natom_kind
520 iatom = atomic_kind%atom_list(ia)
521 force(:, iatom) = qs_force(ikind)%dispersion(:, ia)
522 END DO
523 END DO
524 CASE DEFAULT
525 cpabort("")
526 END SELECT
527
528 END SUBROUTINE get_qs_force
529
530! **************************************************************************************************
531!> \brief Get current total force
532!> \param force Input force, dimension (3,natom)
533!> \param qs_force The force type variable to be used
534!> \param atomic_kind_set ...
535!> \par History
536!> 09.2019 JGH
537!> \author JGH
538! **************************************************************************************************
539 SUBROUTINE total_qs_force(force, qs_force, atomic_kind_set)
540
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
544
545 INTEGER :: ia, iatom, ikind, natom_kind
546 TYPE(atomic_kind_type), POINTER :: atomic_kind
547
548! ------------------------------------------------------------------------
549
550 force(:, :) = 0.0_dp
551 DO ikind = 1, SIZE(atomic_kind_set, 1)
552 atomic_kind => atomic_kind_set(ikind)
553 CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind)
554 DO ia = 1, natom_kind
555 iatom = atomic_kind%atom_list(ia)
556 force(:, iatom) = qs_force(ikind)%core_overlap(:, ia) + &
557 qs_force(ikind)%gth_ppl(:, ia) + &
558 qs_force(ikind)%gth_nlcc(:, ia) + &
559 qs_force(ikind)%gth_ppnl(:, ia) + &
560 qs_force(ikind)%all_potential(:, ia) + &
561 qs_force(ikind)%kinetic(:, ia) + &
562 qs_force(ikind)%overlap(:, ia) + &
563 qs_force(ikind)%overlap_admm(:, ia) + &
564 qs_force(ikind)%rho_core(:, ia) + &
565 qs_force(ikind)%rho_elec(:, ia) + &
566 qs_force(ikind)%rho_lri_elec(:, ia) + &
567 qs_force(ikind)%vhxc_atom(:, ia) + &
568 qs_force(ikind)%g0s_Vh_elec(:, ia) + &
569 qs_force(ikind)%fock_4c(:, ia) + &
570 qs_force(ikind)%mp2_non_sep(:, ia) + &
571 qs_force(ikind)%repulsive(:, ia) + &
572 qs_force(ikind)%dispersion(:, ia) + &
573 qs_force(ikind)%gcp(:, ia) + &
574 qs_force(ikind)%ehrenfest(:, ia) + &
575 qs_force(ikind)%efield(:, ia) + &
576 qs_force(ikind)%eev(:, ia)
577 END DO
578 END DO
579
580 END SUBROUTINE total_qs_force
581
582! **************************************************************************************************
583!> \brief Write a Quickstep force data for 1 atom
584!> \param qs_force ...
585!> \param ikind ...
586!> \param iatom ...
587!> \param iunit ...
588!> \date 05.06.2002
589!> \author MK/JGH
590!> \version 1.0
591! **************************************************************************************************
592 SUBROUTINE write_forces_debug(qs_force, ikind, iatom, iunit)
593
594 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
595 INTEGER, INTENT(IN), OPTIONAL :: ikind, iatom, iunit
596
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
602
603 IF (PRESENT(iunit)) THEN
604 iounit = iunit
605 ELSE
606 NULLIFY (logger)
607 logger => cp_get_default_logger()
608 iounit = cp_logger_get_default_io_unit(logger)
609 END IF
610 IF (PRESENT(ikind)) THEN
611 jkind = ikind
612 ELSE
613 jkind = 1
614 END IF
615 IF (PRESENT(iatom)) THEN
616 jatom = iatom
617 ELSE
618 jatom = 1
619 END IF
620
621 IF (iounit > 0) THEN
622
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))"
625
626 WRITE (unit=iounit, fmt=fmtstr1) &
627 "FORCES [a.u.]", "Atom", "Kind", "Component", "X", "Y", "Z"
628
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)
640
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)
654
655 END IF
656
657 END SUBROUTINE write_forces_debug
658
659END MODULE qs_force_types
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
atomic_kind_types::get_atomic_kind
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.
Definition atomic_kind_types.F:138
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_io_unit
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...
Definition cp_log_handling.F:515
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
qs_force_types
Definition qs_force_types.F:13
qs_force_types::sum_qs_force
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.
Definition qs_force_types.F:292
qs_force_types::replicate_qs_force
subroutine, public replicate_qs_force(qs_force, para_env)
Replicate and sum up the force.
Definition qs_force_types.F:360
qs_force_types::deallocate_qs_force
subroutine, public deallocate_qs_force(qs_force)
Deallocate a Quickstep force data structure.
Definition qs_force_types.F:131
qs_force_types::zero_qs_force
subroutine, public zero_qs_force(qs_force)
Initialize a Quickstep force data structure.
Definition qs_force_types.F:250
qs_force_types::add_qs_force
subroutine, public add_qs_force(force, qs_force, forcetype, atomic_kind_set)
Add force to a force_type variable.
Definition qs_force_types.F:425
qs_force_types::allocate_qs_force
subroutine, public allocate_qs_force(qs_force, natom_of_kind)
Allocate a Quickstep force data structure.
Definition qs_force_types.F:79
qs_force_types::get_qs_force
subroutine, public get_qs_force(force, qs_force, forcetype, atomic_kind_set)
Get force from a force_type variable.
Definition qs_force_types.F:503
qs_force_types::put_qs_force
subroutine, public put_qs_force(force, qs_force, forcetype, atomic_kind_set)
Put force to a force_type variable.
Definition qs_force_types.F:465
qs_force_types::total_qs_force
subroutine, public total_qs_force(force, qs_force, atomic_kind_set)
Get current total force.
Definition qs_force_types.F:540
qs_force_types::write_forces_debug
subroutine, public write_forces_debug(qs_force, ikind, iatom, iunit)
Write a Quickstep force data for 1 atom.
Definition qs_force_types.F:593
qs_force
Quickstep force driver routine.
Definition qs_force.F:12
atomic_kind_types::atomic_kind_type
Provides all information about an atomic kind.
Definition atomic_kind_types.F:45
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:763
qs_force_types::qs_force_type
Definition qs_force_types.F:28