(git:919a8b9)
Loading...
Searching...
No Matches
cp_subsys_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!> \brief types that represent a subsys, i.e. a part of the system
10!> \par History
11!> 07.2003 created [fawzi]
12!> 09.2007 cleaned [tlaino] - University of Zurich
13!> 22.11.2010 pack/unpack particle routines added (MK)
14!> \author Fawzi Mohamed
15! **************************************************************************************************
16MODULE cp_subsys_types
17 USE atomic_kind_list_types, ONLY: atomic_kind_list_release,&
18 atomic_kind_list_retain,&
19 atomic_kind_list_type
20 USE atomic_kind_types, ONLY: atomic_kind_type
21 USE atprop_types, ONLY: atprop_release,&
22 atprop_type
23 USE cell_types, ONLY: cell_release,&
24 cell_retain,&
25 cell_type,&
26 real_to_scaled,&
27 scaled_to_real
28 USE colvar_types, ONLY: colvar_p_release,&
29 colvar_p_type
30 USE cp_result_types, ONLY: cp_result_release,&
31 cp_result_retain,&
32 cp_result_type
33 USE distribution_1d_types, ONLY: distribution_1d_release,&
34 distribution_1d_retain,&
35 distribution_1d_type
36 USE kinds, ONLY: dp
37 USE message_passing, ONLY: mp_para_env_release,&
38 mp_para_env_type
39 USE molecule_kind_list_types, ONLY: molecule_kind_list_release,&
40 molecule_kind_list_retain,&
41 molecule_kind_list_type
42 USE molecule_kind_types, ONLY: molecule_kind_type
43 USE molecule_list_types, ONLY: molecule_list_release,&
44 molecule_list_retain,&
45 molecule_list_type
46 USE molecule_types, ONLY: deallocate_global_constraint,&
47 global_constraint_type,&
48 molecule_type
49 USE multipole_types, ONLY: multipole_type,&
50 release_multipole_type
51 USE particle_list_types, ONLY: particle_list_release,&
52 particle_list_retain,&
53 particle_list_type
54 USE particle_types, ONLY: particle_type
55 USE virial_types, ONLY: virial_type
56#include "../base/base_uses.f90"
57
58 IMPLICIT NONE
59 PRIVATE
60
61 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_subsys_types'
62 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .false.
63
64 PUBLIC :: cp_subsys_type, &
65 cp_subsys_p_type
66
67 PUBLIC :: cp_subsys_retain, &
68 cp_subsys_release, &
69 cp_subsys_get, &
70 cp_subsys_set, &
71 pack_subsys_particles, &
72 unpack_subsys_particles
73
74! **************************************************************************************************
75!> \brief represents a system: atoms, molecules, their pos,vel,...
76!> \param atomic_kinds list with all the kinds in the actual subsys
77!> \param particles list with the particles of the actual subsys
78!> \param local_particles the particles that are local to the actual processor
79!> \param molecule_kinds list with the molecule kinds
80!> \param local_molecules the molecule structures of the actual subsys
81!> that are local to this processor
82!> \param para_env the parallel environment of the actual subsys
83!> \param shell_particles list with the shells of the actual subsys if shell-model is used
84!> \param core_particles list with the shells of the actual subsys if shell-model is used
85!> \par History
86!> 07.2003 created [fawzi]
87!> \author Fawzi Mohamed
88! **************************************************************************************************
89 TYPE cp_subsys_type
90 INTEGER :: ref_count = 1
91 REAL(kind=dp), DIMENSION(3, 2) :: seed = -1
92 TYPE(atomic_kind_list_type), POINTER :: atomic_kinds => null()
93 TYPE(particle_list_type), POINTER :: particles => null()
94 TYPE(particle_list_type), POINTER :: shell_particles => null()
95 TYPE(particle_list_type), POINTER :: core_particles => null()
96 TYPE(distribution_1d_type), POINTER :: local_particles => null()
97 TYPE(mp_para_env_type), POINTER :: para_env => null()
98 ! molecules kinds
99 TYPE(molecule_list_type), POINTER :: molecules => null()
100 TYPE(molecule_kind_list_type), POINTER :: molecule_kinds => null()
101 TYPE(distribution_1d_type), POINTER :: local_molecules => null()
102 ! Definitions of the collective variables
103 TYPE(colvar_p_type), DIMENSION(:), POINTER :: colvar_p => null()
104 ! Intermolecular constraints
105 TYPE(global_constraint_type), POINTER :: gci => null()
106 ! Multipoles
107 TYPE(multipole_type), POINTER :: multipoles => null()
108 TYPE(atprop_type), POINTER :: atprop => null()
109 TYPE(virial_type), POINTER :: virial => null()
110 TYPE(cp_result_type), POINTER :: results => null()
111 TYPE(cell_type), POINTER :: cell => null(), cell_ref => null()
112 LOGICAL :: use_ref_cell = .false.
113 END TYPE cp_subsys_type
114
115! **************************************************************************************************
116!> \brief represent a pointer to a subsys, to be able to create arrays
117!> of pointers
118!> \param subsys the pointer to the subsys
119!> \par History
120!> 07.2003 created [fawzi]
121!> \author Fawzi Mohamed
122! **************************************************************************************************
123 TYPE cp_subsys_p_type
124 TYPE(cp_subsys_type), POINTER :: subsys => null()
125 END TYPE cp_subsys_p_type
126
127CONTAINS
128
129! **************************************************************************************************
130!> \brief retains a subsys (see doc/ReferenceCounting.html)
131!> \param subsys the subsys to retain
132!> \par History
133!> 07.2003 created [fawzi]
134!> \author Fawzi Mohamed
135! **************************************************************************************************
136 SUBROUTINE cp_subsys_retain(subsys)
137 TYPE(cp_subsys_type), INTENT(INOUT) :: subsys
138
139 cpassert(subsys%ref_count > 0)
140 subsys%ref_count = subsys%ref_count + 1
141 END SUBROUTINE cp_subsys_retain
142
143! **************************************************************************************************
144!> \brief releases a subsys (see doc/ReferenceCounting.html)
145!> \param subsys the subsys to release
146!> \par History
147!> 07.2003 created [fawzi]
148!> \author Fawzi Mohamed
149! **************************************************************************************************
150 SUBROUTINE cp_subsys_release(subsys)
151 TYPE(cp_subsys_type), POINTER :: subsys
152
153 IF (ASSOCIATED(subsys)) THEN
154 cpassert(subsys%ref_count > 0)
155 subsys%ref_count = subsys%ref_count - 1
156 IF (subsys%ref_count == 0) THEN
157 CALL atomic_kind_list_release(subsys%atomic_kinds)
158 CALL particle_list_release(subsys%particles)
159 CALL particle_list_release(subsys%shell_particles)
160 CALL particle_list_release(subsys%core_particles)
161 CALL distribution_1d_release(subsys%local_particles)
162 CALL molecule_kind_list_release(subsys%molecule_kinds)
163 CALL molecule_list_release(subsys%molecules)
164 CALL distribution_1d_release(subsys%local_molecules)
165 CALL mp_para_env_release(subsys%para_env)
166 IF (ASSOCIATED(subsys%multipoles)) THEN
167 CALL release_multipole_type(subsys%multipoles)
168 DEALLOCATE (subsys%multipoles)
169 END IF
170 CALL colvar_p_release(subsys%colvar_p)
171 CALL deallocate_global_constraint(subsys%gci)
172 CALL atprop_release(subsys%atprop)
173 IF (ASSOCIATED(subsys%virial)) DEALLOCATE (subsys%virial)
174 CALL cp_result_release(subsys%results)
175 CALL cell_release(subsys%cell)
176 CALL cell_release(subsys%cell_ref)
177 DEALLOCATE (subsys)
178 END IF
179 NULLIFY (subsys)
180 END IF
181 END SUBROUTINE cp_subsys_release
182
183! **************************************************************************************************
184!> \brief sets various propreties of the subsys
185!> \param subsys the subsys you want to modify
186!> \param atomic_kinds ...
187!> \param particles ...
188!> \param local_particles ...
189!> \param molecules ...
190!> \param molecule_kinds ...
191!> \param local_molecules ...
192!> \param para_env ...
193!> \param colvar_p ...
194!> \param shell_particles ...
195!> \param core_particles ...
196!> \param gci ...
197!> \param multipoles ...
198!> \param results ...
199!> \param cell ...
200!> \param cell_ref ...
201!> \param use_ref_cell ...
202!> \par History
203!> 08.2003 created [fawzi]
204!> \author Fawzi Mohamed
205! **************************************************************************************************
206 SUBROUTINE cp_subsys_set(subsys, atomic_kinds, particles, local_particles, &
207 molecules, molecule_kinds, local_molecules, para_env, &
208 colvar_p, shell_particles, core_particles, gci, multipoles, &
209 results, cell, cell_ref, use_ref_cell)
210 TYPE(cp_subsys_type), INTENT(INOUT) :: subsys
211 TYPE(atomic_kind_list_type), OPTIONAL, POINTER :: atomic_kinds
212 TYPE(particle_list_type), OPTIONAL, POINTER :: particles
213 TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles
214 TYPE(molecule_list_type), OPTIONAL, POINTER :: molecules
215 TYPE(molecule_kind_list_type), OPTIONAL, POINTER :: molecule_kinds
216 TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_molecules
217 TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
218 TYPE(colvar_p_type), DIMENSION(:), OPTIONAL, &
219 POINTER :: colvar_p
220 TYPE(particle_list_type), OPTIONAL, POINTER :: shell_particles, core_particles
221 TYPE(global_constraint_type), OPTIONAL, POINTER :: gci
222 TYPE(multipole_type), OPTIONAL, POINTER :: multipoles
223 TYPE(cp_result_type), OPTIONAL, POINTER :: results
224 TYPE(cell_type), OPTIONAL, POINTER :: cell, cell_ref
225 LOGICAL, OPTIONAL :: use_ref_cell
226
227 cpassert(subsys%ref_count > 0)
228 IF (PRESENT(multipoles)) THEN
229 IF (ASSOCIATED(subsys%multipoles)) THEN
230 IF (.NOT. ASSOCIATED(subsys%multipoles, multipoles)) THEN
231 CALL release_multipole_type(subsys%multipoles)
232 DEALLOCATE (subsys%multipoles)
233 END IF
234 END IF
235 subsys%multipoles => multipoles
236 END IF
237 IF (PRESENT(atomic_kinds)) THEN
238 CALL atomic_kind_list_retain(atomic_kinds)
239 CALL atomic_kind_list_release(subsys%atomic_kinds)
240 subsys%atomic_kinds => atomic_kinds
241 END IF
242 IF (PRESENT(particles)) THEN
243 CALL particle_list_retain(particles)
244 CALL particle_list_release(subsys%particles)
245 subsys%particles => particles
246 END IF
247 IF (PRESENT(local_particles)) THEN
248 CALL distribution_1d_retain(local_particles)
249 CALL distribution_1d_release(subsys%local_particles)
250 subsys%local_particles => local_particles
251 END IF
252 IF (PRESENT(local_molecules)) THEN
253 CALL distribution_1d_retain(local_molecules)
254 CALL distribution_1d_release(subsys%local_molecules)
255 subsys%local_molecules => local_molecules
256 END IF
257 IF (PRESENT(molecule_kinds)) THEN
258 CALL molecule_kind_list_retain(molecule_kinds)
259 CALL molecule_kind_list_release(subsys%molecule_kinds)
260 subsys%molecule_kinds => molecule_kinds
261 END IF
262 IF (PRESENT(molecules)) THEN
263 CALL molecule_list_retain(molecules)
264 CALL molecule_list_release(subsys%molecules)
265 subsys%molecules => molecules
266 END IF
267 IF (PRESENT(para_env)) THEN
268 CALL para_env%retain()
269 CALL mp_para_env_release(subsys%para_env)
270 subsys%para_env => para_env
271 END IF
272 IF (PRESENT(colvar_p)) THEN
273 cpassert(.NOT. ASSOCIATED(subsys%colvar_p))
274 subsys%colvar_p => colvar_p
275 END IF
276 IF (PRESENT(shell_particles)) THEN
277 IF (ASSOCIATED(shell_particles)) THEN
278 CALL particle_list_retain(shell_particles)
279 CALL particle_list_release(subsys%shell_particles)
280 subsys%shell_particles => shell_particles
281 END IF
282 END IF
283 IF (PRESENT(core_particles)) THEN
284 IF (ASSOCIATED(core_particles)) THEN
285 CALL particle_list_retain(core_particles)
286 CALL particle_list_release(subsys%core_particles)
287 subsys%core_particles => core_particles
288 END IF
289 END IF
290 IF (PRESENT(gci)) THEN
291 cpassert(.NOT. ASSOCIATED(subsys%gci))
292 subsys%gci => gci
293 END IF
294 IF (PRESENT(results)) THEN
295 IF (ASSOCIATED(results)) THEN
296 CALL cp_result_retain(results)
297 CALL cp_result_release(subsys%results)
298 subsys%results => results
299 END IF
300 END IF
301 IF (PRESENT(cell)) THEN
302 IF (ASSOCIATED(cell)) THEN
303 CALL cell_retain(cell)
304 CALL cell_release(subsys%cell)
305 subsys%cell => cell
306 END IF
307 END IF
308 IF (PRESENT(cell_ref)) THEN
309 IF (ASSOCIATED(cell_ref)) THEN
310 CALL cell_retain(cell_ref)
311 CALL cell_release(subsys%cell_ref)
312 subsys%cell_ref => cell_ref
313 subsys%use_ref_cell = .true.
314 END IF
315 END IF
316 IF (PRESENT(use_ref_cell)) THEN
317 subsys%use_ref_cell = use_ref_cell
318 END IF
319 END SUBROUTINE cp_subsys_set
320
321! **************************************************************************************************
322!> \brief returns information about various attributes of the given subsys
323!> \param subsys the subsys you want info about
324!> \param ref_count ...
325!> \param atomic_kinds ...
326!> \param atomic_kind_set ...
327!> \param particles ...
328!> \param particle_set ...
329!> \param local_particles ...
330!> \param molecules ...
331!> \param molecule_set ...
332!> \param molecule_kinds ...
333!> \param molecule_kind_set ...
334!> \param local_molecules ...
335!> \param para_env ...
336!> \param colvar_p ...
337!> \param shell_particles ...
338!> \param core_particles ...
339!> \param gci ...
340!> \param multipoles ...
341!> \param natom ...
342!> \param nparticle ...
343!> \param ncore ...
344!> \param nshell ...
345!> \param nkind ...
346!> \param atprop ...
347!> \param virial ...
348!> \param results ...
349!> \param cell ...
350!> \param cell_ref ...
351!> \param use_ref_cell ...
352!> \par History
353!> 08.2003 created [fawzi]
354!> 22.11.2010 (MK)
355!> \author Fawzi Mohamed
356! **************************************************************************************************
357 SUBROUTINE cp_subsys_get(subsys, ref_count, atomic_kinds, atomic_kind_set, &
358 particles, particle_set, &
359 local_particles, molecules, molecule_set, molecule_kinds, &
360 molecule_kind_set, local_molecules, para_env, colvar_p, &
361 shell_particles, core_particles, gci, multipoles, &
362 natom, nparticle, ncore, nshell, nkind, atprop, virial, &
363 results, cell, cell_ref, use_ref_cell)
364 TYPE(cp_subsys_type), INTENT(IN) :: subsys
365 INTEGER, INTENT(out), OPTIONAL :: ref_count
366 TYPE(atomic_kind_list_type), OPTIONAL, POINTER :: atomic_kinds
367 TYPE(atomic_kind_type), DIMENSION(:), OPTIONAL, &
368 POINTER :: atomic_kind_set
369 TYPE(particle_list_type), OPTIONAL, POINTER :: particles
370 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
371 POINTER :: particle_set
372 TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles
373 TYPE(molecule_list_type), OPTIONAL, POINTER :: molecules
374 TYPE(molecule_type), DIMENSION(:), OPTIONAL, &
375 POINTER :: molecule_set
376 TYPE(molecule_kind_list_type), OPTIONAL, POINTER :: molecule_kinds
377 TYPE(molecule_kind_type), DIMENSION(:), OPTIONAL, &
378 POINTER :: molecule_kind_set
379 TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_molecules
380 TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
381 TYPE(colvar_p_type), DIMENSION(:), OPTIONAL, &
382 POINTER :: colvar_p
383 TYPE(particle_list_type), OPTIONAL, POINTER :: shell_particles, core_particles
384 TYPE(global_constraint_type), OPTIONAL, POINTER :: gci
385 TYPE(multipole_type), OPTIONAL, POINTER :: multipoles
386 INTEGER, INTENT(out), OPTIONAL :: natom, nparticle, ncore, nshell, nkind
387 TYPE(atprop_type), OPTIONAL, POINTER :: atprop
388 TYPE(virial_type), OPTIONAL, POINTER :: virial
389 TYPE(cp_result_type), OPTIONAL, POINTER :: results
390 TYPE(cell_type), OPTIONAL, POINTER :: cell, cell_ref
391 LOGICAL, OPTIONAL :: use_ref_cell
392
393 INTEGER :: n_atom, n_core, n_shell
394
395 n_atom = 0
396 n_core = 0
397 n_shell = 0
398
399 cpassert(subsys%ref_count > 0)
400
401 IF (PRESENT(ref_count)) ref_count = subsys%ref_count
402 IF (PRESENT(atomic_kinds)) atomic_kinds => subsys%atomic_kinds
403 IF (PRESENT(atomic_kind_set)) atomic_kind_set => subsys%atomic_kinds%els
404 IF (PRESENT(particles)) particles => subsys%particles
405 IF (PRESENT(particle_set)) particle_set => subsys%particles%els
406 IF (PRESENT(local_particles)) local_particles => subsys%local_particles
407 IF (PRESENT(molecules)) molecules => subsys%molecules
408 IF (PRESENT(molecule_set)) molecule_set => subsys%molecules%els
409 IF (PRESENT(molecule_kinds)) molecule_kinds => subsys%molecule_kinds
410 IF (PRESENT(molecule_kind_set)) molecule_kind_set => subsys%molecule_kinds%els
411 IF (PRESENT(local_molecules)) local_molecules => subsys%local_molecules
412 IF (PRESENT(para_env)) para_env => subsys%para_env
413 IF (PRESENT(colvar_p)) colvar_p => subsys%colvar_p
414 IF (PRESENT(shell_particles)) shell_particles => subsys%shell_particles
415 IF (PRESENT(core_particles)) core_particles => subsys%core_particles
416 IF (PRESENT(gci)) gci => subsys%gci
417 IF (PRESENT(multipoles)) multipoles => subsys%multipoles
418 IF (PRESENT(virial)) virial => subsys%virial
419 IF (PRESENT(atprop)) atprop => subsys%atprop
420 IF (PRESENT(results)) results => subsys%results
421 IF (PRESENT(cell)) cell => subsys%cell
422 IF (PRESENT(cell_ref)) cell_ref => subsys%cell_ref
423 IF (PRESENT(use_ref_cell)) use_ref_cell = subsys%use_ref_cell
424 IF (PRESENT(nkind)) nkind = SIZE(subsys%atomic_kinds%els)
425
426 IF (PRESENT(natom) .OR. PRESENT(nparticle) .OR. PRESENT(nshell)) THEN
427 ! An atomic particle set should be present in each subsystem at the moment
428 cpassert(ASSOCIATED(subsys%particles))
429 n_atom = subsys%particles%n_els
430 ! Check if we have other kinds of particles in this subsystem
431 IF (ASSOCIATED(subsys%shell_particles)) THEN
432 n_shell = subsys%shell_particles%n_els
433 cpassert(ASSOCIATED(subsys%core_particles))
434 n_core = subsys%core_particles%n_els
435 ! The same number of shell and core particles is assumed
436 cpassert(n_core == n_shell)
437 ELSE IF (ASSOCIATED(subsys%core_particles)) THEN
438 ! This case should not occur at the moment
439 cpassert(ASSOCIATED(subsys%shell_particles))
440 ELSE
441 n_core = 0
442 n_shell = 0
443 END IF
444 IF (PRESENT(natom)) natom = n_atom
445 IF (PRESENT(nparticle)) nparticle = n_atom + n_shell
446 IF (PRESENT(ncore)) ncore = n_core
447 IF (PRESENT(nshell)) nshell = n_shell
448 END IF
449
450 END SUBROUTINE cp_subsys_get
451
452! **************************************************************************************************
453!> \brief Pack components of a subsystem particle sets into a single vector
454!> \param subsys ...
455!> \param f ...
456!> \param r ...
457!> \param s ...
458!> \param v ...
459!> \param fscale ...
460!> \param cell ...
461!> \date 19.11.10
462!> \author Matthias Krack (MK)
463!> \version 1.0
464!> \note It is assumed that f, r, s, or v are properly allocated already
465! **************************************************************************************************
466 SUBROUTINE pack_subsys_particles(subsys, f, r, s, v, fscale, cell)
467
468 TYPE(cp_subsys_type), INTENT(IN) :: subsys
469 REAL(kind=dp), DIMENSION(:), INTENT(OUT), OPTIONAL :: f, r, s, v
470 REAL(kind=dp), INTENT(IN), OPTIONAL :: fscale
471 TYPE(cell_type), OPTIONAL, POINTER :: cell
472
473 INTEGER :: i, iatom, j, k, natom, nparticle, nsize, &
474 shell_index
475 REAL(kind=dp), DIMENSION(3) :: rs
476 TYPE(particle_list_type), POINTER :: core_particles, particles, &
477 shell_particles
478
479 IF (PRESENT(s)) THEN
480 cpassert(PRESENT(cell))
481 cpassert(ASSOCIATED(cell))
482 END IF
483
484 NULLIFY (core_particles)
485 NULLIFY (particles)
486 NULLIFY (shell_particles)
487
488 CALL cp_subsys_get(subsys, &
489 core_particles=core_particles, &
490 natom=natom, &
491 nparticle=nparticle, &
492 particles=particles, &
493 shell_particles=shell_particles)
494
495 nsize = 3*nparticle
496
497 ! Pack forces
498
499 IF (PRESENT(f)) THEN
500 cpassert((SIZE(f) >= nsize))
501 j = 0
502 DO iatom = 1, natom
503 shell_index = particles%els(iatom)%shell_index
504 IF (shell_index == 0) THEN
505 DO i = 1, 3
506 j = j + 1
507 f(j) = particles%els(iatom)%f(i)
508 END DO
509 ELSE
510 DO i = 1, 3
511 j = j + 1
512 f(j) = core_particles%els(shell_index)%f(i)
513 END DO
514 k = 3*(natom + shell_index - 1)
515 DO i = 1, 3
516 f(k + i) = shell_particles%els(shell_index)%f(i)
517 END DO
518 END IF
519 END DO
520 IF (PRESENT(fscale)) f(1:nsize) = fscale*f(1:nsize)
521 END IF
522
523 ! Pack coordinates
524
525 IF (PRESENT(r)) THEN
526 cpassert((SIZE(r) >= nsize))
527 j = 0
528 DO iatom = 1, natom
529 shell_index = particles%els(iatom)%shell_index
530 IF (shell_index == 0) THEN
531 DO i = 1, 3
532 j = j + 1
533 r(j) = particles%els(iatom)%r(i)
534 END DO
535 ELSE
536 DO i = 1, 3
537 j = j + 1
538 r(j) = core_particles%els(shell_index)%r(i)
539 END DO
540 k = 3*(natom + shell_index - 1)
541 DO i = 1, 3
542 r(k + i) = shell_particles%els(shell_index)%r(i)
543 END DO
544 END IF
545 END DO
546 END IF
547
548 ! Pack as scaled coordinates
549
550 IF (PRESENT(s)) THEN
551 cpassert((SIZE(s) >= nsize))
552 j = 0
553 DO iatom = 1, natom
554 shell_index = particles%els(iatom)%shell_index
555 IF (shell_index == 0) THEN
556 CALL real_to_scaled(rs, particles%els(iatom)%r, cell)
557 DO i = 1, 3
558 j = j + 1
559 s(j) = rs(i)
560 END DO
561 ELSE
562 CALL real_to_scaled(rs, core_particles%els(shell_index)%r, cell)
563 DO i = 1, 3
564 j = j + 1
565 s(j) = rs(i)
566 END DO
567 CALL real_to_scaled(rs, shell_particles%els(shell_index)%r, cell)
568 k = 3*(natom + shell_index - 1)
569 DO i = 1, 3
570 s(k + i) = rs(i)
571 END DO
572 END IF
573 END DO
574 END IF
575
576 ! Pack velocities
577
578 IF (PRESENT(v)) THEN
579 cpassert((SIZE(v) >= nsize))
580 j = 0
581 DO iatom = 1, natom
582 shell_index = particles%els(iatom)%shell_index
583 IF (shell_index == 0) THEN
584 DO i = 1, 3
585 j = j + 1
586 v(j) = particles%els(iatom)%v(i)
587 END DO
588 ELSE
589 DO i = 1, 3
590 j = j + 1
591 v(j) = core_particles%els(shell_index)%v(i)
592 END DO
593 k = 3*(natom + shell_index - 1)
594 DO i = 1, 3
595 v(k + i) = shell_particles%els(shell_index)%v(i)
596 END DO
597 END IF
598 END DO
599 END IF
600
601 END SUBROUTINE pack_subsys_particles
602
603! **************************************************************************************************
604!> \brief Unpack components of a subsystem particle sets into a single vector
605!> \param subsys ...
606!> \param f ...
607!> \param r ...
608!> \param s ...
609!> \param v ...
610!> \param fscale ...
611!> \param cell ...
612!> \date 19.11.10
613!> \author Matthias Krack (MK)
614!> \version 1.0
615! **************************************************************************************************
616 SUBROUTINE unpack_subsys_particles(subsys, f, r, s, v, fscale, cell)
617
618 TYPE(cp_subsys_type), INTENT(IN) :: subsys
619 REAL(kind=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: f, r, s, v
620 REAL(kind=dp), INTENT(IN), OPTIONAL :: fscale
621 TYPE(cell_type), OPTIONAL, POINTER :: cell
622
623 INTEGER :: i, iatom, j, k, natom, nparticle, nsize, &
624 shell_index
625 REAL(kind=dp) :: fc, fs, mass, my_fscale
626 REAL(kind=dp), DIMENSION(3) :: rs
627 TYPE(particle_list_type), POINTER :: core_particles, particles, &
628 shell_particles
629
630 NULLIFY (core_particles)
631 NULLIFY (particles)
632 NULLIFY (shell_particles)
633
634 CALL cp_subsys_get(subsys, &
635 core_particles=core_particles, &
636 natom=natom, &
637 nparticle=nparticle, &
638 particles=particles, &
639 shell_particles=shell_particles)
640
641 nsize = 3*nparticle
642
643 ! Unpack forces
644
645 IF (PRESENT(f)) THEN
646 cpassert((SIZE(f) >= nsize))
647 IF (PRESENT(fscale)) THEN
648 my_fscale = fscale
649 ELSE
650 my_fscale = 1.0_dp
651 END IF
652 j = 0
653 DO iatom = 1, natom
654 shell_index = particles%els(iatom)%shell_index
655 IF (shell_index == 0) THEN
656 DO i = 1, 3
657 j = j + 1
658 particles%els(iatom)%f(i) = my_fscale*f(j)
659 END DO
660 ELSE
661 DO i = 1, 3
662 j = j + 1
663 core_particles%els(shell_index)%f(i) = my_fscale*f(j)
664 END DO
665 k = 3*(natom + shell_index - 1)
666 DO i = 1, 3
667 shell_particles%els(shell_index)%f(i) = my_fscale*f(k + i)
668 END DO
669 END IF
670 END DO
671 END IF
672
673 ! Unpack coordinates
674
675 IF (PRESENT(r)) THEN
676 cpassert((SIZE(r) >= nsize))
677 j = 0
678 DO iatom = 1, natom
679 shell_index = particles%els(iatom)%shell_index
680 IF (shell_index == 0) THEN
681 DO i = 1, 3
682 j = j + 1
683 particles%els(iatom)%r(i) = r(j)
684 END DO
685 ELSE
686 DO i = 1, 3
687 j = j + 1
688 core_particles%els(shell_index)%r(i) = r(j)
689 END DO
690 k = 3*(natom + shell_index - 1)
691 DO i = 1, 3
692 shell_particles%els(shell_index)%r(i) = r(k + i)
693 END DO
694 ! Update atomic position due to core and shell motion
695 mass = particles%els(iatom)%atomic_kind%mass
696 fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
697 fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass
698 particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3) + &
699 fs*shell_particles%els(shell_index)%r(1:3)
700 END IF
701 END DO
702 END IF
703
704 ! Unpack scaled coordinates
705
706 IF (PRESENT(s)) THEN
707 cpassert((SIZE(s) >= nsize))
708 cpassert(PRESENT(cell))
709 cpassert(ASSOCIATED(cell))
710 j = 0
711 DO iatom = 1, natom
712 shell_index = particles%els(iatom)%shell_index
713 IF (shell_index == 0) THEN
714 DO i = 1, 3
715 j = j + 1
716 rs(i) = s(j)
717 END DO
718 CALL scaled_to_real(particles%els(iatom)%r, rs, cell)
719 ELSE
720 DO i = 1, 3
721 j = j + 1
722 rs(i) = s(j)
723 END DO
724 CALL scaled_to_real(core_particles%els(shell_index)%r, rs, cell)
725 k = 3*(natom + shell_index - 1)
726 DO i = 1, 3
727 rs(i) = s(k + i)
728 END DO
729 CALL scaled_to_real(shell_particles%els(shell_index)%r, rs, cell)
730 ! Update atomic position due to core and shell motion
731 mass = particles%els(iatom)%atomic_kind%mass
732 fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
733 fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass
734 particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3) + &
735 fs*shell_particles%els(shell_index)%r(1:3)
736 END IF
737 END DO
738 END IF
739
740 ! Unpack velocities
741
742 IF (PRESENT(v)) THEN
743 cpassert((SIZE(v) >= nsize))
744 j = 0
745 DO iatom = 1, natom
746 shell_index = particles%els(iatom)%shell_index
747 IF (shell_index == 0) THEN
748 DO i = 1, 3
749 j = j + 1
750 particles%els(iatom)%v(i) = v(j)
751 END DO
752 ELSE
753 DO i = 1, 3
754 j = j + 1
755 core_particles%els(shell_index)%v(i) = v(j)
756 END DO
757 k = 3*(natom + shell_index - 1)
758 DO i = 1, 3
759 shell_particles%els(shell_index)%v(i) = v(k + i)
760 END DO
761 ! Update atomic velocity due to core and shell motion
762 mass = particles%els(iatom)%atomic_kind%mass
763 fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
764 fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass
765 particles%els(iatom)%v(1:3) = fc*core_particles%els(shell_index)%v(1:3) + &
766 fs*shell_particles%els(shell_index)%v(1:3)
767 END IF
768 END DO
769 END IF
770
771 END SUBROUTINE unpack_subsys_particles
772
773END MODULE cp_subsys_types
atomic_kind_list_types
represent a simple array based list of the given type
Definition atomic_kind_list_types.F:15
atomic_kind_list_types::atomic_kind_list_release
subroutine, public atomic_kind_list_release(list)
releases a list (see doc/ReferenceCounting.html)
Definition atomic_kind_list_types.F:128
atomic_kind_list_types::atomic_kind_list_retain
subroutine, public atomic_kind_list_retain(list)
retains a list (see doc/ReferenceCounting.html)
Definition atomic_kind_list_types.F:113
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
atprop_types
Holds information on atomic properties.
Definition atprop_types.F:14
atprop_types::atprop_release
subroutine, public atprop_release(atprop_env)
releases the atprop
Definition atprop_types.F:133
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
cell_types::scaled_to_real
subroutine, public scaled_to_real(r, s, cell)
Transform scaled cell coordinates real coordinates. r=h*s.
Definition cell_types.F:521
cell_types::real_to_scaled
subroutine, public real_to_scaled(s, r, cell)
Transform real to scaled cell coordinates. s=h_inv*r.
Definition cell_types.F:491
cell_types::cell_release
subroutine, public cell_release(cell)
releases the given cell (see doc/ReferenceCounting.html)
Definition cell_types.F:564
cell_types::cell_retain
subroutine, public cell_retain(cell)
retains the given cell (see doc/ReferenceCounting.html)
Definition cell_types.F:547
colvar_types
Initialize the collective variables types.
Definition colvar_types.F:15
colvar_types::colvar_p_release
subroutine, public colvar_p_release(colvar_p)
Deallocate a set of colvar_p_type.
Definition colvar_types.F:1837
cp_result_types
set of type/routines to handle the storage of results in force_envs
Definition cp_result_types.F:18
cp_result_types::cp_result_retain
subroutine, public cp_result_retain(results)
Retains cp_result type.
Definition cp_result_types.F:183
cp_result_types::cp_result_release
subroutine, public cp_result_release(results)
Releases cp_result type.
Definition cp_result_types.F:120
cp_subsys_types
types that represent a subsys, i.e. a part of the system
Definition cp_subsys_types.F:16
cp_subsys_types::cp_subsys_set
subroutine, public cp_subsys_set(subsys, atomic_kinds, particles, local_particles, molecules, molecule_kinds, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, results, cell, cell_ref, use_ref_cell)
sets various propreties of the subsys
Definition cp_subsys_types.F:210
cp_subsys_types::cp_subsys_release
subroutine, public cp_subsys_release(subsys)
releases a subsys (see doc/ReferenceCounting.html)
Definition cp_subsys_types.F:151
cp_subsys_types::unpack_subsys_particles
subroutine, public unpack_subsys_particles(subsys, f, r, s, v, fscale, cell)
Unpack components of a subsystem particle sets into a single vector.
Definition cp_subsys_types.F:617
cp_subsys_types::cp_subsys_get
subroutine, public cp_subsys_get(subsys, ref_count, 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)
returns information about various attributes of the given subsys
Definition cp_subsys_types.F:364
cp_subsys_types::cp_subsys_retain
subroutine, public cp_subsys_retain(subsys)
retains a subsys (see doc/ReferenceCounting.html)
Definition cp_subsys_types.F:137
cp_subsys_types::pack_subsys_particles
subroutine, public pack_subsys_particles(subsys, f, r, s, v, fscale, cell)
Pack components of a subsystem particle sets into a single vector.
Definition cp_subsys_types.F:467
distribution_1d_types
stores a lists of integer that are local to a processor. The idea is that these integers represent ob...
Definition distribution_1d_types.F:24
distribution_1d_types::distribution_1d_retain
subroutine, public distribution_1d_retain(distribution_1d)
retains a distribution_1d
Definition distribution_1d_types.F:135
distribution_1d_types::distribution_1d_release
subroutine, public distribution_1d_release(distribution_1d)
releases the given distribution_1d
Definition distribution_1d_types.F:149
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
message_passing::mp_para_env_release
subroutine, public mp_para_env_release(para_env)
releases the para object (to be called when you don't want anymore the shared copy of this object)
Definition message_passing.F:2011
molecule_kind_list_types
represent a simple array based list of the given type
Definition molecule_kind_list_types.F:15
molecule_kind_list_types::molecule_kind_list_release
subroutine, public molecule_kind_list_release(list)
releases a list (see doc/ReferenceCounting.html)
Definition molecule_kind_list_types.F:128
molecule_kind_list_types::molecule_kind_list_retain
subroutine, public molecule_kind_list_retain(list)
retains a list (see doc/ReferenceCounting.html)
Definition molecule_kind_list_types.F:113
molecule_kind_types
Define the molecule kind structure types and the corresponding functionality.
Definition molecule_kind_types.F:16
molecule_list_types
represent a simple array based list of the given type
Definition molecule_list_types.F:15
molecule_list_types::molecule_list_retain
subroutine, public molecule_list_retain(list)
retains a list (see doc/ReferenceCounting.html)
Definition molecule_list_types.F:114
molecule_list_types::molecule_list_release
subroutine, public molecule_list_release(list)
releases a list (see doc/ReferenceCounting.html)
Definition molecule_list_types.F:129
molecule_types
Define the data structure for the molecule information.
Definition molecule_types.F:16
molecule_types::deallocate_global_constraint
subroutine, public deallocate_global_constraint(gci)
Deallocate a global constraint.
Definition molecule_types.F:201
multipole_types
Multipole structure: for multipole (fixed and induced) in FF based MD.
Definition multipole_types.F:12
multipole_types::release_multipole_type
subroutine, public release_multipole_type(multipoles)
...
Definition multipole_types.F:150
particle_list_types
represent a simple array based list of the given type
Definition particle_list_types.F:15
particle_list_types::particle_list_retain
subroutine, public particle_list_retain(list)
retains a list (see doc/ReferenceCounting.html)
Definition particle_list_types.F:114
particle_list_types::particle_list_release
subroutine, public particle_list_release(list)
releases a list (see doc/ReferenceCounting.html)
Definition particle_list_types.F:129
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
virial_types
Definition virial_types.F:13
atomic_kind_list_types::atomic_kind_list_type
represent a list of objects
Definition atomic_kind_list_types.F:45
atomic_kind_types::atomic_kind_type
Provides all information about an atomic kind.
Definition atomic_kind_types.F:45
atprop_types::atprop_type
type for the atomic properties
Definition atprop_types.F:31
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
colvar_types::colvar_p_type
Definition colvar_types.F:383
cp_result_types::cp_result_type
contains arbitrary information which need to be stored
Definition cp_result_types.F:73
cp_subsys_types::cp_subsys_p_type
represent a pointer to a subsys, to be able to create arrays of pointers
Definition cp_subsys_types.F:123
cp_subsys_types::cp_subsys_type
represents a system: atoms, molecules, their pos,vel,...
Definition cp_subsys_types.F:89
distribution_1d_types::distribution_1d_type
structure to store local (to a processor) ordered lists of integers.
Definition distribution_1d_types.F:62
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:743
molecule_kind_list_types::molecule_kind_list_type
represent a list of objects
Definition molecule_kind_list_types.F:45
molecule_kind_types::molecule_kind_type
Definition molecule_kind_types.F:151
molecule_list_types::molecule_list_type
represent a list of objects
Definition molecule_list_types.F:46
molecule_types::global_constraint_type
Definition molecule_types.F:134
molecule_types::molecule_type
Definition molecule_types.F:159
multipole_types::multipole_type
Define multipole type.
Definition multipole_types.F:44
particle_list_types::particle_list_type
represent a list of objects
Definition particle_list_types.F:46
particle_types::particle_type
Definition particle_types.F:35
virial_types::virial_type
Definition virial_types.F:26