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 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_sum
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 = -1, &
42 : t_region_index = -1, &
43 : shell_index = -1
44 : END TYPE particle_type
45 :
46 : ! Public data types
47 :
48 : PUBLIC :: particle_type
49 :
50 : ! Public subroutines
51 :
52 : PUBLIC :: allocate_particle_set, &
53 : deallocate_particle_set, &
54 : update_particle_set, &
55 : update_particle_pos_or_vel, &
56 : get_particle_pos_or_vel
57 :
58 : CONTAINS
59 :
60 : ! **************************************************************************************************
61 : !> \brief Allocate a particle set.
62 : !> \param particle_set ...
63 : !> \param nparticle ...
64 : !> \date 14.01.2002
65 : !> \author MK
66 : !> \version 1.0
67 : ! **************************************************************************************************
68 16988 : SUBROUTINE allocate_particle_set(particle_set, nparticle)
69 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
70 : INTEGER, INTENT(IN) :: nparticle
71 :
72 : INTEGER :: iparticle
73 :
74 16988 : IF (ASSOCIATED(particle_set)) THEN
75 0 : CALL deallocate_particle_set(particle_set)
76 : END IF
77 1236654 : ALLOCATE (particle_set(nparticle))
78 :
79 1015810 : DO iparticle = 1, nparticle
80 998822 : NULLIFY (particle_set(iparticle)%atomic_kind)
81 3995288 : particle_set(iparticle)%f(:) = 0.0_dp
82 3995288 : particle_set(iparticle)%r(:) = 0.0_dp
83 3995288 : particle_set(iparticle)%v(:) = 0.0_dp
84 998822 : particle_set(iparticle)%shell_index = 0
85 998822 : particle_set(iparticle)%atom_index = 0
86 1015810 : particle_set(iparticle)%t_region_index = 0
87 : END DO
88 :
89 16988 : END SUBROUTINE allocate_particle_set
90 :
91 : ! **************************************************************************************************
92 : !> \brief Deallocate a particle set.
93 : !> \param particle_set ...
94 : !> \date 14.01.2002
95 : !> \author MK
96 : !> \version 1.0
97 : ! **************************************************************************************************
98 16988 : SUBROUTINE deallocate_particle_set(particle_set)
99 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
100 :
101 16988 : IF (ASSOCIATED(particle_set)) THEN
102 16988 : DEALLOCATE (particle_set)
103 : ELSE
104 : CALL cp_abort(__LOCATION__, &
105 : "The pointer particle_set is not associated and "// &
106 0 : "cannot be deallocated")
107 : END IF
108 :
109 16988 : END SUBROUTINE deallocate_particle_set
110 :
111 : ! **************************************************************************************************
112 : !> \brief ...
113 : !> \param particle_set ...
114 : !> \param int_group ...
115 : !> \param pos ...
116 : !> \param vel ...
117 : !> \param for ...
118 : !> \param add ...
119 : ! **************************************************************************************************
120 96746 : SUBROUTINE update_particle_set(particle_set, int_group, pos, vel, for, add)
121 :
122 : TYPE(particle_type), INTENT(INOUT) :: particle_set(:)
123 : INTEGER, INTENT(IN) :: int_group
124 : REAL(KIND=dp), INTENT(INOUT), OPTIONAL :: pos(:, :), vel(:, :), for(:, :)
125 : LOGICAL, INTENT(IN), OPTIONAL :: add
126 :
127 : CHARACTER(len=*), PARAMETER :: routineN = 'update_particle_set'
128 :
129 : INTEGER :: handle, iparticle, nparticle
130 : LOGICAL :: my_add, update_for, update_pos, &
131 : update_vel
132 :
133 96746 : CALL timeset(routineN, handle)
134 :
135 96746 : nparticle = SIZE(particle_set)
136 96746 : update_pos = PRESENT(pos)
137 96746 : update_vel = PRESENT(vel)
138 96746 : update_for = PRESENT(for)
139 96746 : my_add = .FALSE.
140 96746 : IF (PRESENT(add)) my_add = add
141 :
142 96746 : IF (update_pos) THEN
143 47075 : CALL mp_sum(pos, int_group)
144 47075 : IF (my_add) THEN
145 0 : DO iparticle = 1, nparticle
146 0 : particle_set(iparticle)%r(:) = particle_set(iparticle)%r(:) + pos(:, iparticle)
147 : END DO
148 : ELSE
149 6218441 : DO iparticle = 1, nparticle
150 24732539 : particle_set(iparticle)%r(:) = pos(:, iparticle)
151 : END DO
152 : END IF
153 : END IF
154 96746 : IF (update_vel) THEN
155 48141 : CALL mp_sum(vel, int_group)
156 48141 : IF (my_add) THEN
157 0 : DO iparticle = 1, nparticle
158 0 : particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:) + vel(:, iparticle)
159 : END DO
160 : ELSE
161 6203045 : DO iparticle = 1, nparticle
162 24667757 : particle_set(iparticle)%v(:) = vel(:, iparticle)
163 : END DO
164 : END IF
165 : END IF
166 96746 : IF (update_for) THEN
167 1530 : CALL mp_sum(for, int_group)
168 1530 : IF (my_add) THEN
169 17772 : DO iparticle = 1, nparticle
170 66498 : particle_set(iparticle)%f(:) = particle_set(iparticle)%f(:) + for(:, iparticle)
171 : END DO
172 : ELSE
173 0 : DO iparticle = 1, nparticle
174 0 : particle_set(iparticle)%f(:) = for(:, iparticle)
175 : END DO
176 : END IF
177 : END IF
178 :
179 96746 : CALL timestop(handle)
180 :
181 96746 : END SUBROUTINE update_particle_set
182 :
183 : ! **************************************************************************************************
184 : !> \brief Return the atomic position or velocity of atom iatom in x from a
185 : !> packed vector even if core-shell particles are present
186 : !> \param iatom ...
187 : !> \param particle_set ...
188 : !> \param vector ...
189 : !> \return ...
190 : !> \date 25.11.2010
191 : !> \author Matthias Krack
192 : !> \version 1.0
193 : ! **************************************************************************************************
194 375784 : FUNCTION get_particle_pos_or_vel(iatom, particle_set, vector) RESULT(x)
195 :
196 : INTEGER, INTENT(IN) :: iatom
197 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
198 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: vector
199 : REAL(KIND=dp), DIMENSION(3) :: x
200 :
201 : INTEGER :: ic, is
202 : REAL(KIND=dp) :: fc, fs, mass
203 :
204 375784 : ic = 3*(iatom - 1)
205 375784 : IF (particle_set(iatom)%shell_index == 0) THEN
206 739336 : x(1:3) = vector(ic + 1:ic + 3)
207 : ELSE
208 190950 : is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
209 190950 : mass = particle_set(iatom)%atomic_kind%mass
210 190950 : fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
211 190950 : fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
212 763800 : x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
213 : END IF
214 :
215 375784 : END FUNCTION get_particle_pos_or_vel
216 :
217 : ! **************************************************************************************************
218 : !> \brief Update the atomic position or velocity by x and return the updated
219 : !> atomic position or velocity in x even if core-shell particles are
220 : !> present
221 : !> \param iatom ...
222 : !> \param particle_set ...
223 : !> \param x ...
224 : !> \param vector ...
225 : !> \date 26.11.2010
226 : !> \author Matthias Krack
227 : !> \version 1.0
228 : !> \note particle-set is not changed, only the positions or velocities in
229 : !> the packed vector are updated
230 : ! **************************************************************************************************
231 1020 : SUBROUTINE update_particle_pos_or_vel(iatom, particle_set, x, vector)
232 :
233 : INTEGER, INTENT(IN) :: iatom
234 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
235 : REAL(KIND=dp), DIMENSION(3), INTENT(INOUT) :: x
236 : REAL(KIND=dp), DIMENSION(:), INTENT(INOUT) :: vector
237 :
238 : INTEGER :: ic, is
239 : REAL(KIND=dp) :: fc, fs, mass
240 :
241 1020 : ic = 3*(iatom - 1)
242 1020 : IF (particle_set(iatom)%shell_index == 0) THEN
243 4080 : vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
244 4080 : x(1:3) = vector(ic + 1:ic + 3)
245 : ELSE
246 0 : is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
247 0 : mass = particle_set(iatom)%atomic_kind%mass
248 0 : fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
249 0 : fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
250 0 : vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
251 0 : vector(is + 1:is + 3) = vector(is + 1:is + 3) + x(1:3)
252 0 : x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
253 : END IF
254 :
255 1020 : END SUBROUTINE update_particle_pos_or_vel
256 :
257 0 : END MODULE particle_types
|
