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 Define the data structure for the particle information.
10 : !> \par History
11 : !> - Atomic kind added in particle_type (MK,08.01.2002)
12 : !> - Functionality for particle_type added (MK,14.01.2002)
13 : !> - Allow for general coordinate input (MK,13.09.2003)
14 : !> - Molecule concept introduced (MK,26.09.2003)
15 : !> - Last atom information added (jgh,23.05.2004)
16 : !> - particle_type cleaned (MK,03.02.2005)
17 : !> \author CJM, MK
18 : ! **************************************************************************************************
19 : MODULE particle_types
20 : USE atomic_kind_types, ONLY: atomic_kind_type
21 : USE kinds, ONLY: dp
22 : USE message_passing, ONLY: mp_comm_type
23 : #include "../base/base_uses.f90"
24 :
25 : IMPLICIT NONE
26 :
27 : PRIVATE
28 :
29 : ! Global parameters (in this module)
30 :
31 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'particle_types'
32 :
33 : ! Data types
34 : ! **************************************************************************************************
35 : TYPE particle_type
36 : TYPE(atomic_kind_type), POINTER :: atomic_kind => Null() ! atomic kind information
37 : REAL(KIND=dp), DIMENSION(3) :: f = 0.0_dp, & ! force
38 : r = 0.0_dp, & ! position
39 : v = 0.0_dp ! velocity
40 : ! Particle dependent terms for shell-model
41 : INTEGER :: atom_index = 0, &
42 : t_region_index = 0, &
43 : shell_index = 0, &
44 : fragment_index = 0
45 : END TYPE particle_type
46 :
47 : ! Public data types
48 :
49 : PUBLIC :: particle_type
50 :
51 : ! Public subroutines
52 :
53 : PUBLIC :: allocate_particle_set, &
54 : deallocate_particle_set, &
55 : update_particle_set, &
56 : update_particle_pos_or_vel, &
57 : get_particle_pos_or_vel
58 :
59 : CONTAINS
60 :
61 : ! **************************************************************************************************
62 : !> \brief Allocate a particle set.
63 : !> \param particle_set ...
64 : !> \param nparticle ...
65 : !> \date 14.01.2002
66 : !> \author MK
67 : !> \version 1.0
68 : ! **************************************************************************************************
69 22368 : SUBROUTINE allocate_particle_set(particle_set, nparticle)
70 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
71 : INTEGER, INTENT(IN) :: nparticle
72 :
73 22368 : IF (ASSOCIATED(particle_set)) THEN
74 0 : CALL deallocate_particle_set(particle_set)
75 : END IF
76 1366622 : ALLOCATE (particle_set(nparticle))
77 :
78 22368 : END SUBROUTINE allocate_particle_set
79 :
80 : ! **************************************************************************************************
81 : !> \brief Deallocate a particle set.
82 : !> \param particle_set ...
83 : !> \date 14.01.2002
84 : !> \author MK
85 : !> \version 1.0
86 : ! **************************************************************************************************
87 22368 : SUBROUTINE deallocate_particle_set(particle_set)
88 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
89 :
90 22368 : IF (ASSOCIATED(particle_set)) THEN
91 22368 : DEALLOCATE (particle_set)
92 : NULLIFY (particle_set)
93 : END IF
94 :
95 22368 : END SUBROUTINE deallocate_particle_set
96 :
97 : ! **************************************************************************************************
98 : !> \brief ...
99 : !> \param particle_set ...
100 : !> \param int_group ...
101 : !> \param pos ...
102 : !> \param vel ...
103 : !> \param for ...
104 : !> \param add ...
105 : ! **************************************************************************************************
106 92520 : SUBROUTINE update_particle_set(particle_set, int_group, pos, vel, for, add)
107 :
108 : TYPE(particle_type), INTENT(INOUT) :: particle_set(:)
109 :
110 : CLASS(mp_comm_type), INTENT(IN) :: int_group
111 : REAL(KIND=dp), INTENT(INOUT), OPTIONAL :: pos(:, :), vel(:, :), for(:, :)
112 : LOGICAL, INTENT(IN), OPTIONAL :: add
113 :
114 : CHARACTER(len=*), PARAMETER :: routineN = 'update_particle_set'
115 :
116 : INTEGER :: handle, iparticle, nparticle
117 : LOGICAL :: my_add, update_for, update_pos, &
118 : update_vel
119 :
120 92520 : CALL timeset(routineN, handle)
121 :
122 92520 : nparticle = SIZE(particle_set)
123 92520 : update_pos = PRESENT(pos)
124 92520 : update_vel = PRESENT(vel)
125 92520 : update_for = PRESENT(for)
126 92520 : my_add = .FALSE.
127 92520 : IF (PRESENT(add)) my_add = add
128 :
129 92520 : IF (update_pos) THEN
130 51940587 : CALL int_group%sum(pos)
131 44939 : IF (my_add) THEN
132 0 : DO iparticle = 1, nparticle
133 0 : particle_set(iparticle)%r(:) = particle_set(iparticle)%r(:) + pos(:, iparticle)
134 : END DO
135 : ELSE
136 6531895 : DO iparticle = 1, nparticle
137 25992763 : particle_set(iparticle)%r(:) = pos(:, iparticle)
138 : END DO
139 : END IF
140 : END IF
141 92520 : IF (update_vel) THEN
142 51811091 : CALL int_group%sum(vel)
143 46051 : IF (my_add) THEN
144 0 : DO iparticle = 1, nparticle
145 0 : particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:) + vel(:, iparticle)
146 : END DO
147 : ELSE
148 6516681 : DO iparticle = 1, nparticle
149 25928571 : particle_set(iparticle)%v(:) = vel(:, iparticle)
150 : END DO
151 : END IF
152 : END IF
153 92520 : IF (update_for) THEN
154 131466 : CALL int_group%sum(for)
155 1530 : IF (my_add) THEN
156 17772 : DO iparticle = 1, nparticle
157 66498 : particle_set(iparticle)%f(:) = particle_set(iparticle)%f(:) + for(:, iparticle)
158 : END DO
159 : ELSE
160 0 : DO iparticle = 1, nparticle
161 0 : particle_set(iparticle)%f(:) = for(:, iparticle)
162 : END DO
163 : END IF
164 : END IF
165 :
166 92520 : CALL timestop(handle)
167 :
168 92520 : END SUBROUTINE update_particle_set
169 :
170 : ! **************************************************************************************************
171 : !> \brief Return the atomic position or velocity of atom iatom in x from a
172 : !> packed vector even if core-shell particles are present
173 : !> \param iatom ...
174 : !> \param particle_set ...
175 : !> \param vector ...
176 : !> \return ...
177 : !> \date 25.11.2010
178 : !> \author Matthias Krack
179 : !> \version 1.0
180 : ! **************************************************************************************************
181 363175 : PURE FUNCTION get_particle_pos_or_vel(iatom, particle_set, vector) RESULT(x)
182 :
183 : INTEGER, INTENT(IN) :: iatom
184 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
185 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: vector
186 : REAL(KIND=dp), DIMENSION(3) :: x
187 :
188 : INTEGER :: ic, is
189 : REAL(KIND=dp) :: fc, fs, mass
190 :
191 363175 : ic = 3*(iatom - 1)
192 363175 : IF (particle_set(iatom)%shell_index == 0) THEN
193 758820 : x(1:3) = vector(ic + 1:ic + 3)
194 : ELSE
195 173470 : is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
196 173470 : mass = particle_set(iatom)%atomic_kind%mass
197 173470 : fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
198 173470 : fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
199 693880 : x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
200 : END IF
201 :
202 363175 : END FUNCTION get_particle_pos_or_vel
203 :
204 : ! **************************************************************************************************
205 : !> \brief Update the atomic position or velocity by x and return the updated
206 : !> atomic position or velocity in x even if core-shell particles are
207 : !> present
208 : !> \param iatom ...
209 : !> \param particle_set ...
210 : !> \param x ...
211 : !> \param vector ...
212 : !> \date 26.11.2010
213 : !> \author Matthias Krack
214 : !> \version 1.0
215 : !> \note particle-set is not changed, only the positions or velocities in
216 : !> the packed vector are updated
217 : ! **************************************************************************************************
218 1020 : PURE SUBROUTINE update_particle_pos_or_vel(iatom, particle_set, x, vector)
219 :
220 : INTEGER, INTENT(IN) :: iatom
221 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
222 : REAL(KIND=dp), DIMENSION(3), INTENT(INOUT) :: x
223 : REAL(KIND=dp), DIMENSION(:), INTENT(INOUT) :: vector
224 :
225 : INTEGER :: ic, is
226 : REAL(KIND=dp) :: fc, fs, mass
227 :
228 1020 : ic = 3*(iatom - 1)
229 1020 : IF (particle_set(iatom)%shell_index == 0) THEN
230 4080 : vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
231 4080 : x(1:3) = vector(ic + 1:ic + 3)
232 : ELSE
233 0 : is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
234 0 : mass = particle_set(iatom)%atomic_kind%mass
235 0 : fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
236 0 : fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
237 0 : vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
238 0 : vector(is + 1:is + 3) = vector(is + 1:is + 3) + x(1:3)
239 0 : x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
240 : END IF
241 :
242 1020 : END SUBROUTINE update_particle_pos_or_vel
243 :
244 0 : END MODULE particle_types
|
