(git:d3d49ac)
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-2026 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 => null(), &
30 cneo_potential => null(), &
31 core_overlap => null(), &
32 gth_ppl => null(), &
33 gth_nlcc => null(), &
34 gth_ppnl => null(), &
35 kinetic => null(), &
36 overlap => null(), &
37 overlap_admm => null(), &
38 rho_core => null(), &
39 rho_elec => null(), &
40 rho_lri_elec => null(), &
41 rho_cneo_nuc => null(), &
42 vhxc_atom => null(), &
43 g0s_vh_elec => null(), &
44 repulsive => null(), &
45 dispersion => null(), &
46 gcp => null(), &
47 other => null(), &
48 ch_pulay => null(), &
49 fock_4c => null(), &
50 ehrenfest => null(), &
51 efield => null(), &
52 eev => null(), &
53 mp2_non_sep => null(), &
54 tensorial_u => null(), &
55 total => null()
56 END TYPE qs_force_type
57
58 PUBLIC :: qs_force_type
59
60 PUBLIC :: allocate_qs_force, &
61 add_qs_force, &
62 deallocate_qs_force, &
63 replicate_qs_force, &
64 sum_qs_force, &
65 get_qs_force, &
66 put_qs_force, &
67 total_qs_force, &
68 zero_qs_force, &
69 write_forces_debug
70
71CONTAINS
72
73! **************************************************************************************************
74!> \brief Allocate a Quickstep force data structure.
75!> \param qs_force ...
76!> \param natom_of_kind ...
77!> \date 05.06.2002
78!> \author MK
79!> \version 1.0
80! **************************************************************************************************
81 SUBROUTINE allocate_qs_force(qs_force, natom_of_kind)
82
83 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
84 INTEGER, DIMENSION(:), INTENT(IN) :: natom_of_kind
85
86 INTEGER :: ikind, n, nkind
87
88 IF (ASSOCIATED(qs_force)) CALL deallocate_qs_force(qs_force)
89
90 nkind = SIZE(natom_of_kind)
91
92 ALLOCATE (qs_force(nkind))
93
94 DO ikind = 1, nkind
95 n = natom_of_kind(ikind)
96 ALLOCATE (qs_force(ikind)%all_potential(3, n))
97 ALLOCATE (qs_force(ikind)%cneo_potential(3, n))
98 ALLOCATE (qs_force(ikind)%core_overlap(3, n))
99 ALLOCATE (qs_force(ikind)%gth_ppl(3, n))
100 ALLOCATE (qs_force(ikind)%gth_nlcc(3, n))
101 ALLOCATE (qs_force(ikind)%gth_ppnl(3, n))
102 ALLOCATE (qs_force(ikind)%kinetic(3, n))
103 ALLOCATE (qs_force(ikind)%overlap(3, n))
104 ALLOCATE (qs_force(ikind)%overlap_admm(3, n))
105 ALLOCATE (qs_force(ikind)%rho_core(3, n))
106 ALLOCATE (qs_force(ikind)%rho_elec(3, n))
107 ALLOCATE (qs_force(ikind)%rho_lri_elec(3, n))
108 ALLOCATE (qs_force(ikind)%rho_cneo_nuc(3, n))
109 ALLOCATE (qs_force(ikind)%vhxc_atom(3, n))
110 ALLOCATE (qs_force(ikind)%g0s_Vh_elec(3, n))
111 ALLOCATE (qs_force(ikind)%repulsive(3, n))
112 ALLOCATE (qs_force(ikind)%dispersion(3, n))
113 ALLOCATE (qs_force(ikind)%gcp(3, n))
114 ALLOCATE (qs_force(ikind)%other(3, n))
115 ALLOCATE (qs_force(ikind)%ch_pulay(3, n))
116 ALLOCATE (qs_force(ikind)%ehrenfest(3, n))
117 ALLOCATE (qs_force(ikind)%efield(3, n))
118 ALLOCATE (qs_force(ikind)%eev(3, n))
119 ! Always initialize ch_pulay to zero..
120 qs_force(ikind)%ch_pulay = 0.0_dp
121 ALLOCATE (qs_force(ikind)%fock_4c(3, n))
122 ALLOCATE (qs_force(ikind)%mp2_non_sep(3, n))
123 ALLOCATE (qs_force(ikind)%tensorial_u(3, n))
124 ALLOCATE (qs_force(ikind)%total(3, n))
125 END DO
126
127 END SUBROUTINE allocate_qs_force
128
129! **************************************************************************************************
130!> \brief Deallocate a Quickstep force data structure.
131!> \param qs_force ...
132!> \date 05.06.2002
133!> \author MK
134!> \version 1.0
135! **************************************************************************************************
136 SUBROUTINE deallocate_qs_force(qs_force)
137
138 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
139
140 INTEGER :: ikind, nkind
141
142 cpassert(ASSOCIATED(qs_force))
143
144 nkind = SIZE(qs_force)
145
146 DO ikind = 1, nkind
147
148 IF (ASSOCIATED(qs_force(ikind)%all_potential)) THEN
149 DEALLOCATE (qs_force(ikind)%all_potential)
150 END IF
151
152 IF (ASSOCIATED(qs_force(ikind)%cneo_potential)) THEN
153 DEALLOCATE (qs_force(ikind)%cneo_potential)
154 END IF
155
156 IF (ASSOCIATED(qs_force(ikind)%core_overlap)) THEN
157 DEALLOCATE (qs_force(ikind)%core_overlap)
158 END IF
159
160 IF (ASSOCIATED(qs_force(ikind)%gth_ppl)) THEN
161 DEALLOCATE (qs_force(ikind)%gth_ppl)
162 END IF
163
164 IF (ASSOCIATED(qs_force(ikind)%gth_nlcc)) THEN
165 DEALLOCATE (qs_force(ikind)%gth_nlcc)
166 END IF
167
168 IF (ASSOCIATED(qs_force(ikind)%gth_ppnl)) THEN
169 DEALLOCATE (qs_force(ikind)%gth_ppnl)
170 END IF
171
172 IF (ASSOCIATED(qs_force(ikind)%kinetic)) THEN
173 DEALLOCATE (qs_force(ikind)%kinetic)
174 END IF
175
176 IF (ASSOCIATED(qs_force(ikind)%overlap)) THEN
177 DEALLOCATE (qs_force(ikind)%overlap)
178 END IF
179
180 IF (ASSOCIATED(qs_force(ikind)%overlap_admm)) THEN
181 DEALLOCATE (qs_force(ikind)%overlap_admm)
182 END IF
183
184 IF (ASSOCIATED(qs_force(ikind)%rho_core)) THEN
185 DEALLOCATE (qs_force(ikind)%rho_core)
186 END IF
187
188 IF (ASSOCIATED(qs_force(ikind)%rho_elec)) THEN
189 DEALLOCATE (qs_force(ikind)%rho_elec)
190 END IF
191 IF (ASSOCIATED(qs_force(ikind)%rho_lri_elec)) THEN
192 DEALLOCATE (qs_force(ikind)%rho_lri_elec)
193 END IF
194
195 IF (ASSOCIATED(qs_force(ikind)%rho_cneo_nuc)) THEN
196 DEALLOCATE (qs_force(ikind)%rho_cneo_nuc)
197 END IF
198
199 IF (ASSOCIATED(qs_force(ikind)%vhxc_atom)) THEN
200 DEALLOCATE (qs_force(ikind)%vhxc_atom)
201 END IF
202
203 IF (ASSOCIATED(qs_force(ikind)%g0s_Vh_elec)) THEN
204 DEALLOCATE (qs_force(ikind)%g0s_Vh_elec)
205 END IF
206
207 IF (ASSOCIATED(qs_force(ikind)%repulsive)) THEN
208 DEALLOCATE (qs_force(ikind)%repulsive)
209 END IF
210
211 IF (ASSOCIATED(qs_force(ikind)%dispersion)) THEN
212 DEALLOCATE (qs_force(ikind)%dispersion)
213 END IF
214
215 IF (ASSOCIATED(qs_force(ikind)%gcp)) THEN
216 DEALLOCATE (qs_force(ikind)%gcp)
217 END IF
218
219 IF (ASSOCIATED(qs_force(ikind)%other)) THEN
220 DEALLOCATE (qs_force(ikind)%other)
221 END IF
222
223 IF (ASSOCIATED(qs_force(ikind)%total)) THEN
224 DEALLOCATE (qs_force(ikind)%total)
225 END IF
226
227 IF (ASSOCIATED(qs_force(ikind)%ch_pulay)) THEN
228 DEALLOCATE (qs_force(ikind)%ch_pulay)
229 END IF
230
231 IF (ASSOCIATED(qs_force(ikind)%fock_4c)) THEN
232 DEALLOCATE (qs_force(ikind)%fock_4c)
233 END IF
234
235 IF (ASSOCIATED(qs_force(ikind)%mp2_non_sep)) THEN
236 DEALLOCATE (qs_force(ikind)%mp2_non_sep)
237 END IF
238
239 IF (ASSOCIATED(qs_force(ikind)%tensorial_u)) THEN
240 DEALLOCATE (qs_force(ikind)%tensorial_u)
241 END IF
242
243 IF (ASSOCIATED(qs_force(ikind)%ehrenfest)) THEN
244 DEALLOCATE (qs_force(ikind)%ehrenfest)
245 END IF
246
247 IF (ASSOCIATED(qs_force(ikind)%efield)) THEN
248 DEALLOCATE (qs_force(ikind)%efield)
249 END IF
250
251 IF (ASSOCIATED(qs_force(ikind)%eev)) THEN
252 DEALLOCATE (qs_force(ikind)%eev)
253 END IF
254 END DO
255
256 DEALLOCATE (qs_force)
257
258 END SUBROUTINE deallocate_qs_force
259
260! **************************************************************************************************
261!> \brief Initialize a Quickstep force data structure.
262!> \param qs_force ...
263!> \date 15.07.2002
264!> \author MK
265!> \version 1.0
266! **************************************************************************************************
267 SUBROUTINE zero_qs_force(qs_force)
268
269 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
270
271 INTEGER :: ikind
272
273 cpassert(ASSOCIATED(qs_force))
274
275 DO ikind = 1, SIZE(qs_force)
276 qs_force(ikind)%all_potential(:, :) = 0.0_dp
277 qs_force(ikind)%cneo_potential(:, :) = 0.0_dp
278 qs_force(ikind)%core_overlap(:, :) = 0.0_dp
279 qs_force(ikind)%gth_ppl(:, :) = 0.0_dp
280 qs_force(ikind)%gth_nlcc(:, :) = 0.0_dp
281 qs_force(ikind)%gth_ppnl(:, :) = 0.0_dp
282 qs_force(ikind)%kinetic(:, :) = 0.0_dp
283 qs_force(ikind)%overlap(:, :) = 0.0_dp
284 qs_force(ikind)%overlap_admm(:, :) = 0.0_dp
285 qs_force(ikind)%rho_core(:, :) = 0.0_dp
286 qs_force(ikind)%rho_elec(:, :) = 0.0_dp
287 qs_force(ikind)%rho_lri_elec(:, :) = 0.0_dp
288 qs_force(ikind)%rho_cneo_nuc(:, :) = 0.0_dp
289 qs_force(ikind)%vhxc_atom(:, :) = 0.0_dp
290 qs_force(ikind)%g0s_Vh_elec(:, :) = 0.0_dp
291 qs_force(ikind)%repulsive(:, :) = 0.0_dp
292 qs_force(ikind)%dispersion(:, :) = 0.0_dp
293 qs_force(ikind)%gcp(:, :) = 0.0_dp
294 qs_force(ikind)%other(:, :) = 0.0_dp
295 qs_force(ikind)%fock_4c(:, :) = 0.0_dp
296 qs_force(ikind)%ehrenfest(:, :) = 0.0_dp
297 qs_force(ikind)%efield(:, :) = 0.0_dp
298 qs_force(ikind)%eev(:, :) = 0.0_dp
299 qs_force(ikind)%mp2_non_sep(:, :) = 0.0_dp
300 qs_force(ikind)%tensorial_u(:, :) = 0.0_dp
301 qs_force(ikind)%total(:, :) = 0.0_dp
302 END DO
303
304 END SUBROUTINE zero_qs_force
305
306! **************************************************************************************************
307!> \brief Sum up two qs_force entities qs_force_out = qs_force_out + qs_force_in
308!> \param qs_force_out ...
309!> \param qs_force_in ...
310!> \author JGH
311! **************************************************************************************************
312 SUBROUTINE sum_qs_force(qs_force_out, qs_force_in)
313
314 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force_out, qs_force_in
315
316 INTEGER :: ikind
317
318 cpassert(ASSOCIATED(qs_force_out))
319 cpassert(ASSOCIATED(qs_force_in))
320
321 DO ikind = 1, SIZE(qs_force_out)
322 qs_force_out(ikind)%all_potential(:, :) = qs_force_out(ikind)%all_potential(:, :) + &
323 qs_force_in(ikind)%all_potential(:, :)
324 qs_force_out(ikind)%cneo_potential(:, :) = qs_force_out(ikind)%cneo_potential(:, :) + &
325 qs_force_in(ikind)%cneo_potential(:, :)
326 qs_force_out(ikind)%core_overlap(:, :) = qs_force_out(ikind)%core_overlap(:, :) + &
327 qs_force_in(ikind)%core_overlap(:, :)
328 qs_force_out(ikind)%gth_ppl(:, :) = qs_force_out(ikind)%gth_ppl(:, :) + &
329 qs_force_in(ikind)%gth_ppl(:, :)
330 qs_force_out(ikind)%gth_nlcc(:, :) = qs_force_out(ikind)%gth_nlcc(:, :) + &
331 qs_force_in(ikind)%gth_nlcc(:, :)
332 qs_force_out(ikind)%gth_ppnl(:, :) = qs_force_out(ikind)%gth_ppnl(:, :) + &
333 qs_force_in(ikind)%gth_ppnl(:, :)
334 qs_force_out(ikind)%kinetic(:, :) = qs_force_out(ikind)%kinetic(:, :) + &
335 qs_force_in(ikind)%kinetic(:, :)
336 qs_force_out(ikind)%overlap(:, :) = qs_force_out(ikind)%overlap(:, :) + &
337 qs_force_in(ikind)%overlap(:, :)
338 qs_force_out(ikind)%overlap_admm(:, :) = qs_force_out(ikind)%overlap_admm(:, :) + &
339 qs_force_in(ikind)%overlap_admm(:, :)
340 qs_force_out(ikind)%rho_core(:, :) = qs_force_out(ikind)%rho_core(:, :) + &
341 qs_force_in(ikind)%rho_core(:, :)
342 qs_force_out(ikind)%rho_elec(:, :) = qs_force_out(ikind)%rho_elec(:, :) + &
343 qs_force_in(ikind)%rho_elec(:, :)
344 qs_force_out(ikind)%rho_lri_elec(:, :) = qs_force_out(ikind)%rho_lri_elec(:, :) + &
345 qs_force_in(ikind)%rho_lri_elec(:, :)
346 qs_force_out(ikind)%rho_cneo_nuc(:, :) = qs_force_out(ikind)%rho_cneo_nuc(:, :) + &
347 qs_force_in(ikind)%rho_cneo_nuc(:, :)
348 qs_force_out(ikind)%vhxc_atom(:, :) = qs_force_out(ikind)%vhxc_atom(:, :) + &
349 qs_force_in(ikind)%vhxc_atom(:, :)
350 qs_force_out(ikind)%g0s_Vh_elec(:, :) = qs_force_out(ikind)%g0s_Vh_elec(:, :) + &
351 qs_force_in(ikind)%g0s_Vh_elec(:, :)
352 qs_force_out(ikind)%repulsive(:, :) = qs_force_out(ikind)%repulsive(:, :) + &
353 qs_force_in(ikind)%repulsive(:, :)
354 qs_force_out(ikind)%dispersion(:, :) = qs_force_out(ikind)%dispersion(:, :) + &
355 qs_force_in(ikind)%dispersion(:, :)
356 qs_force_out(ikind)%gcp(:, :) = qs_force_out(ikind)%gcp(:, :) + &
357 qs_force_in(ikind)%gcp(:, :)
358 qs_force_out(ikind)%other(:, :) = qs_force_out(ikind)%other(:, :) + &
359 qs_force_in(ikind)%other(:, :)
360 qs_force_out(ikind)%fock_4c(:, :) = qs_force_out(ikind)%fock_4c(:, :) + &
361 qs_force_in(ikind)%fock_4c(:, :)
362 qs_force_out(ikind)%ehrenfest(:, :) = qs_force_out(ikind)%ehrenfest(:, :) + &
363 qs_force_in(ikind)%ehrenfest(:, :)
364 qs_force_out(ikind)%efield(:, :) = qs_force_out(ikind)%efield(:, :) + &
365 qs_force_in(ikind)%efield(:, :)
366 qs_force_out(ikind)%eev(:, :) = qs_force_out(ikind)%eev(:, :) + &
367 qs_force_in(ikind)%eev(:, :)
368 qs_force_out(ikind)%mp2_non_sep(:, :) = qs_force_out(ikind)%mp2_non_sep(:, :) + &
369 qs_force_in(ikind)%mp2_non_sep(:, :)
370 qs_force_out(ikind)%tensorial_u(:, :) = qs_force_out(ikind)%tensorial_u(:, :) + &
371 qs_force_in(ikind)%tensorial_u(:, :)
372 qs_force_out(ikind)%total(:, :) = qs_force_out(ikind)%total(:, :) + &
373 qs_force_in(ikind)%total(:, :)
374 END DO
375
376 END SUBROUTINE sum_qs_force
377
378! **************************************************************************************************
379!> \brief Replicate and sum up the force
380!> \param qs_force ...
381!> \param para_env ...
382!> \date 25.05.2016
383!> \author JHU
384!> \version 1.0
385! **************************************************************************************************
386 SUBROUTINE replicate_qs_force(qs_force, para_env)
387
388 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
389 TYPE(mp_para_env_type), POINTER :: para_env
390
391 INTEGER :: ikind
392
393 ! *** replicate forces ***
394 DO ikind = 1, SIZE(qs_force)
395 CALL para_env%sum(qs_force(ikind)%overlap)
396 CALL para_env%sum(qs_force(ikind)%overlap_admm)
397 CALL para_env%sum(qs_force(ikind)%kinetic)
398 CALL para_env%sum(qs_force(ikind)%gth_ppl)
399 CALL para_env%sum(qs_force(ikind)%gth_nlcc)
400 CALL para_env%sum(qs_force(ikind)%gth_ppnl)
401 CALL para_env%sum(qs_force(ikind)%all_potential)
402 CALL para_env%sum(qs_force(ikind)%cneo_potential)
403 CALL para_env%sum(qs_force(ikind)%core_overlap)
404 CALL para_env%sum(qs_force(ikind)%rho_core)
405 CALL para_env%sum(qs_force(ikind)%rho_elec)
406 CALL para_env%sum(qs_force(ikind)%rho_lri_elec)
407 CALL para_env%sum(qs_force(ikind)%rho_cneo_nuc)
408 CALL para_env%sum(qs_force(ikind)%vhxc_atom)
409 CALL para_env%sum(qs_force(ikind)%g0s_Vh_elec)
410 CALL para_env%sum(qs_force(ikind)%fock_4c)
411 CALL para_env%sum(qs_force(ikind)%mp2_non_sep)
412 CALL para_env%sum(qs_force(ikind)%repulsive)
413 CALL para_env%sum(qs_force(ikind)%dispersion)
414 CALL para_env%sum(qs_force(ikind)%gcp)
415 CALL para_env%sum(qs_force(ikind)%ehrenfest)
416
417 qs_force(ikind)%total(:, :) = qs_force(ikind)%total(:, :) + &
418 qs_force(ikind)%core_overlap(:, :) + &
419 qs_force(ikind)%gth_ppl(:, :) + &
420 qs_force(ikind)%gth_nlcc(:, :) + &
421 qs_force(ikind)%gth_ppnl(:, :) + &
422 qs_force(ikind)%all_potential(:, :) + &
423 qs_force(ikind)%cneo_potential(:, :) + &
424 qs_force(ikind)%kinetic(:, :) + &
425 qs_force(ikind)%overlap(:, :) + &
426 qs_force(ikind)%overlap_admm(:, :) + &
427 qs_force(ikind)%rho_core(:, :) + &
428 qs_force(ikind)%rho_elec(:, :) + &
429 qs_force(ikind)%rho_lri_elec(:, :) + &
430 qs_force(ikind)%rho_cneo_nuc(:, :) + &
431 qs_force(ikind)%vhxc_atom(:, :) + &
432 qs_force(ikind)%g0s_Vh_elec(:, :) + &
433 qs_force(ikind)%fock_4c(:, :) + &
434 qs_force(ikind)%mp2_non_sep(:, :) + &
435 qs_force(ikind)%tensorial_u(:, :) + &
436 qs_force(ikind)%repulsive(:, :) + &
437 qs_force(ikind)%dispersion(:, :) + &
438 qs_force(ikind)%gcp(:, :) + &
439 qs_force(ikind)%ehrenfest(:, :) + &
440 qs_force(ikind)%efield(:, :) + &
441 qs_force(ikind)%eev(:, :)
442 END DO
443
444 END SUBROUTINE replicate_qs_force
445
446! **************************************************************************************************
447!> \brief Add force to a force_type variable.
448!> \param force Input force, dimension (3,natom)
449!> \param qs_force The force type variable to be used
450!> \param forcetype ...
451!> \param atomic_kind_set ...
452!> \par History
453!> 07.2014 JGH
454!> \author JGH
455! **************************************************************************************************
456 SUBROUTINE add_qs_force(force, qs_force, forcetype, atomic_kind_set)
457
458 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: force
459 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
460 CHARACTER(LEN=*), INTENT(IN) :: forcetype
461 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
462
463 INTEGER :: ia, iatom, ikind, natom_kind
464 TYPE(atomic_kind_type), POINTER :: atomic_kind
465
466! ------------------------------------------------------------------------
467
468 cpassert(ASSOCIATED(qs_force))
469
470 SELECT CASE (forcetype)
471 CASE ("overlap_admm")
472 DO ikind = 1, SIZE(atomic_kind_set, 1)
473 atomic_kind => atomic_kind_set(ikind)
474 CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind)
475 DO ia = 1, natom_kind
476 iatom = atomic_kind%atom_list(ia)
477 qs_force(ikind)%overlap_admm(:, ia) = qs_force(ikind)%overlap_admm(:, ia) + force(:, iatom)
478 END DO
479 END DO
480 CASE DEFAULT
481 CALL cp_abort(__location__, &
482 "<overlap_admm> is supported as the <forcetype> "// &
483 "for add_qs_force, found unknown option "// &
484 "<"//trim(forcetype)//">")
485 END SELECT
486
487 END SUBROUTINE add_qs_force
488
489! **************************************************************************************************
490!> \brief Put force to a force_type variable.
491!> \param force Input force, dimension (3,natom)
492!> \param qs_force The force type variable to be used
493!> \param forcetype ...
494!> \param atomic_kind_set ...
495!> \par History
496!> 09.2019 JGH
497!> \author JGH
498! **************************************************************************************************
499 SUBROUTINE put_qs_force(force, qs_force, forcetype, atomic_kind_set)
500
501 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: force
502 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
503 CHARACTER(LEN=*), INTENT(IN) :: forcetype
504 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
505
506 INTEGER :: ia, iatom, ikind, natom_kind
507 TYPE(atomic_kind_type), POINTER :: atomic_kind
508
509! ------------------------------------------------------------------------
510
511 SELECT CASE (forcetype)
512 CASE ("dispersion")
513 DO ikind = 1, SIZE(atomic_kind_set, 1)
514 atomic_kind => atomic_kind_set(ikind)
515 CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind)
516 DO ia = 1, natom_kind
517 iatom = atomic_kind%atom_list(ia)
518 qs_force(ikind)%dispersion(:, ia) = force(:, iatom)
519 END DO
520 END DO
521 CASE DEFAULT
522 CALL cp_abort(__location__, &
523 "<dispersion> is supported as the <forcetype> "// &
524 "for put_qs_force, found unknown option "// &
525 "<"//trim(forcetype)//">")
526 END SELECT
527
528 END SUBROUTINE put_qs_force
529
530! **************************************************************************************************
531!> \brief Get force from a force_type variable.
532!> \param force Input force, dimension (3,natom)
533!> \param qs_force The force type variable to be used
534!> \param forcetype ...
535!> \param atomic_kind_set ...
536!> \par History
537!> 09.2019 JGH
538!> \author JGH
539! **************************************************************************************************
540 SUBROUTINE get_qs_force(force, qs_force, forcetype, atomic_kind_set)
541
542 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: force
543 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
544 CHARACTER(LEN=*), INTENT(IN) :: forcetype
545 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
546
547 INTEGER :: ia, iatom, ikind, natom_kind
548 TYPE(atomic_kind_type), POINTER :: atomic_kind
549
550! ------------------------------------------------------------------------
551
552 SELECT CASE (forcetype)
553 CASE ("dispersion")
554 DO ikind = 1, SIZE(atomic_kind_set, 1)
555 atomic_kind => atomic_kind_set(ikind)
556 CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind)
557 DO ia = 1, natom_kind
558 iatom = atomic_kind%atom_list(ia)
559 force(:, iatom) = qs_force(ikind)%dispersion(:, ia)
560 END DO
561 END DO
562 CASE DEFAULT
563 CALL cp_abort(__location__, &
564 "<dispersion> is supported as the <forcetype> "// &
565 "for get_qs_force, found unknown option "// &
566 "<"//trim(forcetype)//">")
567 END SELECT
568
569 END SUBROUTINE get_qs_force
570
571! **************************************************************************************************
572!> \brief Get current total force
573!> \param force Input force, dimension (3,natom)
574!> \param qs_force The force type variable to be used
575!> \param atomic_kind_set ...
576!> \par History
577!> 09.2019 JGH
578!> \author JGH
579! **************************************************************************************************
580 SUBROUTINE total_qs_force(force, qs_force, atomic_kind_set)
581
582 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: force
583 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
584 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
585
586 INTEGER :: ia, iatom, ikind, natom_kind
587 TYPE(atomic_kind_type), POINTER :: atomic_kind
588
589! ------------------------------------------------------------------------
590
591 force(:, :) = 0.0_dp
592 DO ikind = 1, SIZE(atomic_kind_set, 1)
593 atomic_kind => atomic_kind_set(ikind)
594 CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind)
595 DO ia = 1, natom_kind
596 iatom = atomic_kind%atom_list(ia)
597 force(:, iatom) = qs_force(ikind)%core_overlap(:, ia) + &
598 qs_force(ikind)%gth_ppl(:, ia) + &
599 qs_force(ikind)%gth_nlcc(:, ia) + &
600 qs_force(ikind)%gth_ppnl(:, ia) + &
601 qs_force(ikind)%all_potential(:, ia) + &
602 qs_force(ikind)%cneo_potential(:, ia) + &
603 qs_force(ikind)%kinetic(:, ia) + &
604 qs_force(ikind)%overlap(:, ia) + &
605 qs_force(ikind)%overlap_admm(:, ia) + &
606 qs_force(ikind)%rho_core(:, ia) + &
607 qs_force(ikind)%rho_elec(:, ia) + &
608 qs_force(ikind)%rho_lri_elec(:, ia) + &
609 qs_force(ikind)%rho_cneo_nuc(:, ia) + &
610 qs_force(ikind)%vhxc_atom(:, ia) + &
611 qs_force(ikind)%g0s_Vh_elec(:, ia) + &
612 qs_force(ikind)%fock_4c(:, ia) + &
613 qs_force(ikind)%mp2_non_sep(:, ia) + &
614 qs_force(ikind)%tensorial_u(:, ia) + &
615 qs_force(ikind)%repulsive(:, ia) + &
616 qs_force(ikind)%dispersion(:, ia) + &
617 qs_force(ikind)%gcp(:, ia) + &
618 qs_force(ikind)%ehrenfest(:, ia) + &
619 qs_force(ikind)%efield(:, ia) + &
620 qs_force(ikind)%eev(:, ia)
621 END DO
622 END DO
623
624 END SUBROUTINE total_qs_force
625
626! **************************************************************************************************
627!> \brief Write a Quickstep force data for 1 atom
628!> \param qs_force ...
629!> \param ikind ...
630!> \param iatom ...
631!> \param iunit ...
632!> \date 05.06.2002
633!> \author MK/JGH
634!> \version 1.0
635! **************************************************************************************************
636 SUBROUTINE write_forces_debug(qs_force, ikind, iatom, iunit)
637
638 TYPE(qs_force_type), DIMENSION(:), POINTER :: qs_force
639 INTEGER, INTENT(IN), OPTIONAL :: ikind, iatom, iunit
640
641 CHARACTER(LEN=35) :: fmtstr2
642 CHARACTER(LEN=48) :: fmtstr1
643 INTEGER :: iounit, jatom, jkind
644 REAL(kind=dp), DIMENSION(3) :: total
645 TYPE(cp_logger_type), POINTER :: logger
646
647 IF (PRESENT(iunit)) THEN
648 iounit = iunit
649 ELSE
650 NULLIFY (logger)
651 logger => cp_get_default_logger()
652 iounit = cp_logger_get_default_io_unit(logger)
653 END IF
654 IF (PRESENT(ikind)) THEN
655 jkind = ikind
656 ELSE
657 jkind = 1
658 END IF
659 IF (PRESENT(iatom)) THEN
660 jatom = iatom
661 ELSE
662 jatom = 1
663 END IF
664
665 IF (iounit > 0) THEN
666
667 fmtstr1 = "(/,T2,A,/,T3,A,T11,A,T23,A,T40,A1,2(17X,A1))"
668 fmtstr2 = "((T2,I5,4X,I4,T18,A,T34,3F18.12))"
669
670 WRITE (unit=iounit, fmt=fmtstr1) &
671 "FORCES [a.u.]", "Atom", "Kind", "Component", "X", "Y", "Z"
672
673 total(1:3) = qs_force(jkind)%overlap(1:3, jatom) &
674 + qs_force(jkind)%overlap_admm(1:3, jatom) &
675 + qs_force(jkind)%kinetic(1:3, jatom) &
676 + qs_force(jkind)%gth_ppl(1:3, jatom) &
677 + qs_force(jkind)%gth_ppnl(1:3, jatom) &
678 + qs_force(jkind)%gth_nlcc(1:3, jatom) &
679 + qs_force(jkind)%all_potential(1:3, jatom) &
680 + qs_force(jkind)%cneo_potential(1:3, jatom) &
681 + qs_force(jkind)%rho_cneo_nuc(1:3, jatom) &
682 + qs_force(jkind)%core_overlap(1:3, jatom) &
683 + qs_force(jkind)%rho_core(1:3, jatom) &
684 + qs_force(jkind)%rho_elec(1:3, jatom) &
685 + qs_force(jkind)%rho_lri_elec(1:3, jatom) &
686 + qs_force(jkind)%vhxc_atom(1:3, jatom) &
687 + qs_force(jkind)%g0s_Vh_elec(1:3, jatom) &
688 + qs_force(jkind)%dispersion(1:3, jatom) &
689 + qs_force(jkind)%repulsive(1:3, jatom) &
690 + qs_force(jkind)%gcp(1:3, jatom) &
691 + qs_force(jkind)%efield(1:3, jatom) &
692 + qs_force(jkind)%eev(1:3, jatom) &
693 + qs_force(jkind)%ehrenfest(1:3, jatom) &
694 + qs_force(jkind)%fock_4c(1:3, jatom) &
695 + qs_force(jkind)%mp2_non_sep(1:3, jatom)
696
697 WRITE (unit=iounit, fmt=fmtstr2) &
698 jatom, jkind, " overlap", qs_force(jkind)%overlap(1:3, jatom), &
699 jatom, jkind, " overlap_admm", qs_force(jkind)%overlap_admm(1:3, jatom), &
700 jatom, jkind, " kinetic", qs_force(jkind)%kinetic(1:3, jatom), &
701 jatom, jkind, " gth_ppl", qs_force(jkind)%gth_ppl(1:3, jatom), &
702 jatom, jkind, " gth_ppnl", qs_force(jkind)%gth_ppnl(1:3, jatom), &
703 jatom, jkind, " gth_nlcc", qs_force(jkind)%gth_nlcc(1:3, jatom), &
704 jatom, jkind, " all_potential", qs_force(jkind)%all_potential(1:3, jatom), &
705 jatom, jkind, "cneo_potential", qs_force(jkind)%cneo_potential(1:3, jatom), &
706 jatom, jkind, " rho_cneo_nuc", qs_force(jkind)%rho_cneo_nuc(1:3, jatom), &
707 jatom, jkind, " core_overlap", qs_force(jkind)%core_overlap(1:3, jatom), &
708 jatom, jkind, " rho_core", qs_force(jkind)%rho_core(1:3, jatom), &
709 jatom, jkind, " rho_elec", qs_force(jkind)%rho_elec(1:3, jatom), &
710 jatom, jkind, " rho_lri_elec", qs_force(jkind)%rho_lri_elec(1:3, jatom), &
711 jatom, jkind, " vhxc_atom", qs_force(jkind)%vhxc_atom(1:3, jatom), &
712 jatom, jkind, " g0s_Vh_elec", qs_force(jkind)%g0s_Vh_elec(1:3, jatom), &
713 jatom, jkind, " dispersion", qs_force(jkind)%dispersion(1:3, jatom), &
714 jatom, jkind, " repulsive", qs_force(jkind)%repulsive(1:3, jatom), &
715 jatom, jkind, " gcp", qs_force(jkind)%gcp(1:3, jatom), &
716 jatom, jkind, " efield", qs_force(jkind)%efield(1:3, jatom), &
717 jatom, jkind, " eev", qs_force(jkind)%eev(1:3, jatom), &
718 jatom, jkind, " ehrenfest", qs_force(jkind)%ehrenfest(1:3, jatom), &
719 jatom, jkind, " fock_4c", qs_force(jkind)%fock_4c(1:3, jatom), &
720 jatom, jkind, " mp2_non_sep", qs_force(jkind)%mp2_non_sep(1:3, jatom), &
721 jatom, jkind, " total", total(1:3)
722
723 END IF
724
725 END SUBROUTINE write_forces_debug
726
727END 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:523
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:313
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:387
qs_force_types::deallocate_qs_force
subroutine, public deallocate_qs_force(qs_force)
Deallocate a Quickstep force data structure.
Definition qs_force_types.F:137
qs_force_types::zero_qs_force
subroutine, public zero_qs_force(qs_force)
Initialize a Quickstep force data structure.
Definition qs_force_types.F:268
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:457
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:82
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:541
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:500
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:581
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:637
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:750
qs_force_types::qs_force_type
Definition qs_force_types.F:28