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