Line data Source code
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 : ! **************************************************************************************************
16 : MODULE 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 :
127 : CONTAINS
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 7762 : SUBROUTINE cp_subsys_retain(subsys)
137 : TYPE(cp_subsys_type), INTENT(INOUT) :: subsys
138 :
139 7762 : CPASSERT(subsys%ref_count > 0)
140 7762 : subsys%ref_count = subsys%ref_count + 1
141 7762 : 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 26091 : SUBROUTINE cp_subsys_release(subsys)
151 : TYPE(cp_subsys_type), POINTER :: subsys
152 :
153 26091 : IF (ASSOCIATED(subsys)) THEN
154 18329 : CPASSERT(subsys%ref_count > 0)
155 18329 : subsys%ref_count = subsys%ref_count - 1
156 18329 : IF (subsys%ref_count == 0) THEN
157 10567 : CALL atomic_kind_list_release(subsys%atomic_kinds)
158 10567 : CALL particle_list_release(subsys%particles)
159 10567 : CALL particle_list_release(subsys%shell_particles)
160 10567 : CALL particle_list_release(subsys%core_particles)
161 10567 : CALL distribution_1d_release(subsys%local_particles)
162 10567 : CALL molecule_kind_list_release(subsys%molecule_kinds)
163 10567 : CALL molecule_list_release(subsys%molecules)
164 10567 : CALL distribution_1d_release(subsys%local_molecules)
165 10567 : CALL mp_para_env_release(subsys%para_env)
166 10567 : IF (ASSOCIATED(subsys%multipoles)) THEN
167 138 : CALL release_multipole_type(subsys%multipoles)
168 138 : DEALLOCATE (subsys%multipoles)
169 : END IF
170 10567 : CALL colvar_p_release(subsys%colvar_p)
171 10567 : CALL deallocate_global_constraint(subsys%gci)
172 10567 : CALL atprop_release(subsys%atprop)
173 10567 : IF (ASSOCIATED(subsys%virial)) DEALLOCATE (subsys%virial)
174 10567 : CALL cp_result_release(subsys%results)
175 10567 : CALL cell_release(subsys%cell)
176 10567 : CALL cell_release(subsys%cell_ref)
177 10567 : DEALLOCATE (subsys)
178 : END IF
179 18329 : NULLIFY (subsys)
180 : END IF
181 26091 : 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 86619 : 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 86619 : CPASSERT(subsys%ref_count > 0)
228 86619 : IF (PRESENT(multipoles)) THEN
229 2641 : IF (ASSOCIATED(subsys%multipoles)) THEN
230 0 : IF (.NOT. ASSOCIATED(subsys%multipoles, multipoles)) THEN
231 0 : CALL release_multipole_type(subsys%multipoles)
232 0 : DEALLOCATE (subsys%multipoles)
233 : END IF
234 : END IF
235 2641 : subsys%multipoles => multipoles
236 : END IF
237 86619 : IF (PRESENT(atomic_kinds)) THEN
238 10567 : CALL atomic_kind_list_retain(atomic_kinds)
239 10567 : CALL atomic_kind_list_release(subsys%atomic_kinds)
240 10567 : subsys%atomic_kinds => atomic_kinds
241 : END IF
242 86619 : IF (PRESENT(particles)) THEN
243 12567 : CALL particle_list_retain(particles)
244 12567 : CALL particle_list_release(subsys%particles)
245 12567 : subsys%particles => particles
246 : END IF
247 86619 : IF (PRESENT(local_particles)) THEN
248 10573 : CALL distribution_1d_retain(local_particles)
249 10573 : CALL distribution_1d_release(subsys%local_particles)
250 10573 : subsys%local_particles => local_particles
251 : END IF
252 86619 : IF (PRESENT(local_molecules)) THEN
253 10573 : CALL distribution_1d_retain(local_molecules)
254 10573 : CALL distribution_1d_release(subsys%local_molecules)
255 10573 : subsys%local_molecules => local_molecules
256 : END IF
257 86619 : IF (PRESENT(molecule_kinds)) THEN
258 10567 : CALL molecule_kind_list_retain(molecule_kinds)
259 10567 : CALL molecule_kind_list_release(subsys%molecule_kinds)
260 10567 : subsys%molecule_kinds => molecule_kinds
261 : END IF
262 86619 : IF (PRESENT(molecules)) THEN
263 10567 : CALL molecule_list_retain(molecules)
264 10567 : CALL molecule_list_release(subsys%molecules)
265 10567 : subsys%molecules => molecules
266 : END IF
267 86619 : IF (PRESENT(para_env)) THEN
268 0 : CALL para_env%retain()
269 0 : CALL mp_para_env_release(subsys%para_env)
270 0 : subsys%para_env => para_env
271 : END IF
272 86619 : IF (PRESENT(colvar_p)) THEN
273 0 : CPASSERT(.NOT. ASSOCIATED(subsys%colvar_p))
274 0 : subsys%colvar_p => colvar_p
275 : END IF
276 86619 : IF (PRESENT(shell_particles)) THEN
277 2641 : IF (ASSOCIATED(shell_particles)) THEN
278 256 : CALL particle_list_retain(shell_particles)
279 256 : CALL particle_list_release(subsys%shell_particles)
280 256 : subsys%shell_particles => shell_particles
281 : END IF
282 : END IF
283 86619 : IF (PRESENT(core_particles)) THEN
284 2641 : IF (ASSOCIATED(core_particles)) THEN
285 256 : CALL particle_list_retain(core_particles)
286 256 : CALL particle_list_release(subsys%core_particles)
287 256 : subsys%core_particles => core_particles
288 : END IF
289 : END IF
290 86619 : IF (PRESENT(gci)) THEN
291 0 : CPASSERT(.NOT. ASSOCIATED(subsys%gci))
292 0 : subsys%gci => gci
293 : END IF
294 86619 : IF (PRESENT(results)) THEN
295 5206 : IF (ASSOCIATED(results)) THEN
296 5206 : CALL cp_result_retain(results)
297 5206 : CALL cp_result_release(subsys%results)
298 5206 : subsys%results => results
299 : END IF
300 : END IF
301 86619 : IF (PRESENT(cell)) THEN
302 29475 : IF (ASSOCIATED(cell)) THEN
303 29475 : CALL cell_retain(cell)
304 29475 : CALL cell_release(subsys%cell)
305 29475 : subsys%cell => cell
306 : END IF
307 : END IF
308 86619 : IF (PRESENT(cell_ref)) THEN
309 10567 : IF (ASSOCIATED(cell_ref)) THEN
310 10567 : CALL cell_retain(cell_ref)
311 10567 : CALL cell_release(subsys%cell_ref)
312 10567 : subsys%cell_ref => cell_ref
313 10567 : subsys%use_ref_cell = .TRUE.
314 : END IF
315 : END IF
316 86619 : IF (PRESENT(use_ref_cell)) THEN
317 10567 : subsys%use_ref_cell = use_ref_cell
318 : END IF
319 86619 : 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 15828135 : 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 15828135 : n_atom = 0
396 15828135 : n_core = 0
397 15828135 : n_shell = 0
398 :
399 15828135 : CPASSERT(subsys%ref_count > 0)
400 :
401 15828135 : IF (PRESENT(ref_count)) ref_count = subsys%ref_count
402 15828135 : IF (PRESENT(atomic_kinds)) atomic_kinds => subsys%atomic_kinds
403 15828135 : IF (PRESENT(atomic_kind_set)) atomic_kind_set => subsys%atomic_kinds%els
404 15828135 : IF (PRESENT(particles)) particles => subsys%particles
405 15828135 : IF (PRESENT(particle_set)) particle_set => subsys%particles%els
406 15828135 : IF (PRESENT(local_particles)) local_particles => subsys%local_particles
407 15828135 : IF (PRESENT(molecules)) molecules => subsys%molecules
408 15828135 : IF (PRESENT(molecule_set)) molecule_set => subsys%molecules%els
409 15828135 : IF (PRESENT(molecule_kinds)) molecule_kinds => subsys%molecule_kinds
410 15828135 : IF (PRESENT(molecule_kind_set)) molecule_kind_set => subsys%molecule_kinds%els
411 15828135 : IF (PRESENT(local_molecules)) local_molecules => subsys%local_molecules
412 15828135 : IF (PRESENT(para_env)) para_env => subsys%para_env
413 15828135 : IF (PRESENT(colvar_p)) colvar_p => subsys%colvar_p
414 15828135 : IF (PRESENT(shell_particles)) shell_particles => subsys%shell_particles
415 15828135 : IF (PRESENT(core_particles)) core_particles => subsys%core_particles
416 15828135 : IF (PRESENT(gci)) gci => subsys%gci
417 15828135 : IF (PRESENT(multipoles)) multipoles => subsys%multipoles
418 15828135 : IF (PRESENT(virial)) virial => subsys%virial
419 15828135 : IF (PRESENT(atprop)) atprop => subsys%atprop
420 15828135 : IF (PRESENT(results)) results => subsys%results
421 15828135 : IF (PRESENT(cell)) cell => subsys%cell
422 15828135 : IF (PRESENT(cell_ref)) cell_ref => subsys%cell_ref
423 15828135 : IF (PRESENT(use_ref_cell)) use_ref_cell = subsys%use_ref_cell
424 15828135 : IF (PRESENT(nkind)) nkind = SIZE(subsys%atomic_kinds%els)
425 :
426 15828135 : 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 763464 : CPASSERT(ASSOCIATED(subsys%particles))
429 763464 : n_atom = subsys%particles%n_els
430 : ! Check if we have other kinds of particles in this subsystem
431 763464 : IF (ASSOCIATED(subsys%shell_particles)) THEN
432 42782 : n_shell = subsys%shell_particles%n_els
433 42782 : CPASSERT(ASSOCIATED(subsys%core_particles))
434 42782 : n_core = subsys%core_particles%n_els
435 : ! The same number of shell and core particles is assumed
436 42782 : CPASSERT(n_core == n_shell)
437 720682 : ELSE IF (ASSOCIATED(subsys%core_particles)) THEN
438 : ! This case should not occur at the moment
439 0 : CPASSERT(ASSOCIATED(subsys%shell_particles))
440 : ELSE
441 : n_core = 0
442 : n_shell = 0
443 : END IF
444 763464 : IF (PRESENT(natom)) natom = n_atom
445 763464 : IF (PRESENT(nparticle)) nparticle = n_atom + n_shell
446 763464 : IF (PRESENT(ncore)) ncore = n_core
447 763464 : IF (PRESENT(nshell)) nshell = n_shell
448 : END IF
449 :
450 15828135 : 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 30166 : 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 30166 : IF (PRESENT(s)) THEN
480 0 : CPASSERT(PRESENT(cell))
481 0 : CPASSERT(ASSOCIATED(cell))
482 : END IF
483 :
484 30166 : NULLIFY (core_particles)
485 30166 : NULLIFY (particles)
486 30166 : 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 30166 : shell_particles=shell_particles)
494 :
495 30166 : nsize = 3*nparticle
496 :
497 : ! Pack forces
498 :
499 30166 : IF (PRESENT(f)) THEN
500 23441 : CPASSERT((SIZE(f) >= nsize))
501 23441 : j = 0
502 1156602 : DO iatom = 1, natom
503 1133161 : shell_index = particles%els(iatom)%shell_index
504 1156602 : IF (shell_index == 0) THEN
505 3333620 : DO i = 1, 3
506 2500215 : j = j + 1
507 3333620 : f(j) = particles%els(iatom)%f(i)
508 : END DO
509 : ELSE
510 1199024 : DO i = 1, 3
511 899268 : j = j + 1
512 1199024 : f(j) = core_particles%els(shell_index)%f(i)
513 : END DO
514 299756 : k = 3*(natom + shell_index - 1)
515 1199024 : DO i = 1, 3
516 1199024 : f(k + i) = shell_particles%els(shell_index)%f(i)
517 : END DO
518 : END IF
519 : END DO
520 2721248 : IF (PRESENT(fscale)) f(1:nsize) = fscale*f(1:nsize)
521 : END IF
522 :
523 : ! Pack coordinates
524 :
525 30166 : IF (PRESENT(r)) THEN
526 6725 : CPASSERT((SIZE(r) >= nsize))
527 6725 : j = 0
528 180115 : DO iatom = 1, natom
529 173390 : shell_index = particles%els(iatom)%shell_index
530 180115 : IF (shell_index == 0) THEN
531 629912 : DO i = 1, 3
532 472434 : j = j + 1
533 629912 : r(j) = particles%els(iatom)%r(i)
534 : END DO
535 : ELSE
536 63648 : DO i = 1, 3
537 47736 : j = j + 1
538 63648 : r(j) = core_particles%els(shell_index)%r(i)
539 : END DO
540 15912 : k = 3*(natom + shell_index - 1)
541 63648 : DO i = 1, 3
542 63648 : 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 30166 : IF (PRESENT(s)) THEN
551 0 : CPASSERT((SIZE(s) >= nsize))
552 0 : j = 0
553 0 : DO iatom = 1, natom
554 0 : shell_index = particles%els(iatom)%shell_index
555 0 : IF (shell_index == 0) THEN
556 0 : CALL real_to_scaled(rs, particles%els(iatom)%r, cell)
557 0 : DO i = 1, 3
558 0 : j = j + 1
559 0 : s(j) = rs(i)
560 : END DO
561 : ELSE
562 0 : CALL real_to_scaled(rs, core_particles%els(shell_index)%r, cell)
563 0 : DO i = 1, 3
564 0 : j = j + 1
565 0 : s(j) = rs(i)
566 : END DO
567 0 : CALL real_to_scaled(rs, shell_particles%els(shell_index)%r, cell)
568 0 : k = 3*(natom + shell_index - 1)
569 0 : DO i = 1, 3
570 0 : s(k + i) = rs(i)
571 : END DO
572 : END IF
573 : END DO
574 : END IF
575 :
576 : ! Pack velocities
577 :
578 30166 : IF (PRESENT(v)) THEN
579 0 : CPASSERT((SIZE(v) >= nsize))
580 0 : j = 0
581 0 : DO iatom = 1, natom
582 0 : shell_index = particles%els(iatom)%shell_index
583 0 : IF (shell_index == 0) THEN
584 0 : DO i = 1, 3
585 0 : j = j + 1
586 0 : v(j) = particles%els(iatom)%v(i)
587 : END DO
588 : ELSE
589 0 : DO i = 1, 3
590 0 : j = j + 1
591 0 : v(j) = core_particles%els(shell_index)%v(i)
592 : END DO
593 0 : k = 3*(natom + shell_index - 1)
594 0 : DO i = 1, 3
595 0 : v(k + i) = shell_particles%els(shell_index)%v(i)
596 : END DO
597 : END IF
598 : END DO
599 : END IF
600 :
601 30166 : 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 42259 : 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 42259 : NULLIFY (core_particles)
631 42259 : NULLIFY (particles)
632 42259 : 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 42259 : shell_particles=shell_particles)
640 :
641 42259 : nsize = 3*nparticle
642 :
643 : ! Unpack forces
644 :
645 42259 : IF (PRESENT(f)) THEN
646 0 : CPASSERT((SIZE(f) >= nsize))
647 0 : IF (PRESENT(fscale)) THEN
648 0 : my_fscale = fscale
649 : ELSE
650 : my_fscale = 1.0_dp
651 : END IF
652 0 : j = 0
653 0 : DO iatom = 1, natom
654 0 : shell_index = particles%els(iatom)%shell_index
655 0 : IF (shell_index == 0) THEN
656 0 : DO i = 1, 3
657 0 : j = j + 1
658 0 : particles%els(iatom)%f(i) = my_fscale*f(j)
659 : END DO
660 : ELSE
661 0 : DO i = 1, 3
662 0 : j = j + 1
663 0 : core_particles%els(shell_index)%f(i) = my_fscale*f(j)
664 : END DO
665 0 : k = 3*(natom + shell_index - 1)
666 0 : DO i = 1, 3
667 0 : 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 42259 : IF (PRESENT(r)) THEN
676 42115 : CPASSERT((SIZE(r) >= nsize))
677 42115 : j = 0
678 1693668 : DO iatom = 1, natom
679 1651553 : shell_index = particles%els(iatom)%shell_index
680 1693668 : IF (shell_index == 0) THEN
681 5548436 : DO i = 1, 3
682 4161327 : j = j + 1
683 5548436 : particles%els(iatom)%r(i) = r(j)
684 : END DO
685 : ELSE
686 1057776 : DO i = 1, 3
687 793332 : j = j + 1
688 1057776 : core_particles%els(shell_index)%r(i) = r(j)
689 : END DO
690 264444 : k = 3*(natom + shell_index - 1)
691 1057776 : DO i = 1, 3
692 1057776 : shell_particles%els(shell_index)%r(i) = r(k + i)
693 : END DO
694 : ! Update atomic position due to core and shell motion
695 264444 : mass = particles%els(iatom)%atomic_kind%mass
696 264444 : fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
697 264444 : 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 2115552 : 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 42259 : IF (PRESENT(s)) THEN
707 0 : CPASSERT((SIZE(s) >= nsize))
708 0 : CPASSERT(PRESENT(cell))
709 0 : CPASSERT(ASSOCIATED(cell))
710 0 : j = 0
711 0 : DO iatom = 1, natom
712 0 : shell_index = particles%els(iatom)%shell_index
713 0 : IF (shell_index == 0) THEN
714 0 : DO i = 1, 3
715 0 : j = j + 1
716 0 : rs(i) = s(j)
717 : END DO
718 0 : CALL scaled_to_real(particles%els(iatom)%r, rs, cell)
719 : ELSE
720 0 : DO i = 1, 3
721 0 : j = j + 1
722 0 : rs(i) = s(j)
723 : END DO
724 0 : CALL scaled_to_real(core_particles%els(shell_index)%r, rs, cell)
725 0 : k = 3*(natom + shell_index - 1)
726 0 : DO i = 1, 3
727 0 : rs(i) = s(k + i)
728 : END DO
729 0 : CALL scaled_to_real(shell_particles%els(shell_index)%r, rs, cell)
730 : ! Update atomic position due to core and shell motion
731 0 : mass = particles%els(iatom)%atomic_kind%mass
732 0 : fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
733 0 : 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 0 : fs*shell_particles%els(shell_index)%r(1:3)
736 : END IF
737 : END DO
738 : END IF
739 :
740 : ! Unpack velocities
741 :
742 42259 : IF (PRESENT(v)) THEN
743 144 : CPASSERT((SIZE(v) >= nsize))
744 144 : j = 0
745 25110 : DO iatom = 1, natom
746 24966 : shell_index = particles%els(iatom)%shell_index
747 25110 : IF (shell_index == 0) THEN
748 98344 : DO i = 1, 3
749 73758 : j = j + 1
750 98344 : particles%els(iatom)%v(i) = v(j)
751 : END DO
752 : ELSE
753 1520 : DO i = 1, 3
754 1140 : j = j + 1
755 1520 : core_particles%els(shell_index)%v(i) = v(j)
756 : END DO
757 380 : k = 3*(natom + shell_index - 1)
758 1520 : DO i = 1, 3
759 1520 : shell_particles%els(shell_index)%v(i) = v(k + i)
760 : END DO
761 : ! Update atomic velocity due to core and shell motion
762 380 : mass = particles%els(iatom)%atomic_kind%mass
763 380 : fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
764 380 : 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 3040 : fs*shell_particles%els(shell_index)%v(1:3)
767 : END IF
768 : END DO
769 : END IF
770 :
771 42259 : END SUBROUTINE unpack_subsys_particles
772 :
773 0 : END MODULE cp_subsys_types
|
