Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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 : 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 18808 : SUBROUTINE allocate_particle_set(particle_set, nparticle)
69 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
70 : INTEGER, INTENT(IN) :: nparticle
71 :
72 18808 : IF (ASSOCIATED(particle_set)) THEN
73 0 : CALL deallocate_particle_set(particle_set)
74 : END IF
75 1286958 : ALLOCATE (particle_set(nparticle))
76 :
77 18808 : END SUBROUTINE allocate_particle_set
78 :
79 : ! **************************************************************************************************
80 : !> \brief Deallocate a particle set.
81 : !> \param particle_set ...
82 : !> \date 14.01.2002
83 : !> \author MK
84 : !> \version 1.0
85 : ! **************************************************************************************************
86 18808 : SUBROUTINE deallocate_particle_set(particle_set)
87 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
88 :
89 18808 : IF (ASSOCIATED(particle_set)) THEN
90 18808 : DEALLOCATE (particle_set)
91 : NULLIFY (particle_set)
92 : END IF
93 :
94 18808 : END SUBROUTINE deallocate_particle_set
95 :
96 : ! **************************************************************************************************
97 : !> \brief ...
98 : !> \param particle_set ...
99 : !> \param int_group ...
100 : !> \param pos ...
101 : !> \param vel ...
102 : !> \param for ...
103 : !> \param add ...
104 : ! **************************************************************************************************
105 94582 : SUBROUTINE update_particle_set(particle_set, int_group, pos, vel, for, add)
106 :
107 : TYPE(particle_type), INTENT(INOUT) :: particle_set(:)
108 :
109 : CLASS(mp_comm_type), INTENT(IN) :: int_group
110 : REAL(KIND=dp), INTENT(INOUT), OPTIONAL :: pos(:, :), vel(:, :), for(:, :)
111 : LOGICAL, INTENT(IN), OPTIONAL :: add
112 :
113 : CHARACTER(len=*), PARAMETER :: routineN = 'update_particle_set'
114 :
115 : INTEGER :: handle, iparticle, nparticle
116 : LOGICAL :: my_add, update_for, update_pos, &
117 : update_vel
118 :
119 94582 : CALL timeset(routineN, handle)
120 :
121 94582 : nparticle = SIZE(particle_set)
122 94582 : update_pos = PRESENT(pos)
123 94582 : update_vel = PRESENT(vel)
124 94582 : update_for = PRESENT(for)
125 94582 : my_add = .FALSE.
126 94582 : IF (PRESENT(add)) my_add = add
127 :
128 94582 : IF (update_pos) THEN
129 51366159 : CALL int_group%sum(pos)
130 45967 : IF (my_add) THEN
131 0 : DO iparticle = 1, nparticle
132 0 : particle_set(iparticle)%r(:) = particle_set(iparticle)%r(:) + pos(:, iparticle)
133 : END DO
134 : ELSE
135 6460991 : DO iparticle = 1, nparticle
136 25706063 : particle_set(iparticle)%r(:) = pos(:, iparticle)
137 : END DO
138 : END IF
139 : END IF
140 94582 : IF (update_vel) THEN
141 51236813 : CALL int_group%sum(vel)
142 47085 : IF (my_add) THEN
143 0 : DO iparticle = 1, nparticle
144 0 : particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:) + vel(:, iparticle)
145 : END DO
146 : ELSE
147 6445801 : DO iparticle = 1, nparticle
148 25641949 : particle_set(iparticle)%v(:) = vel(:, iparticle)
149 : END DO
150 : END IF
151 : END IF
152 94582 : IF (update_for) THEN
153 131466 : CALL int_group%sum(for)
154 1530 : IF (my_add) THEN
155 17772 : DO iparticle = 1, nparticle
156 66498 : particle_set(iparticle)%f(:) = particle_set(iparticle)%f(:) + for(:, iparticle)
157 : END DO
158 : ELSE
159 0 : DO iparticle = 1, nparticle
160 0 : particle_set(iparticle)%f(:) = for(:, iparticle)
161 : END DO
162 : END IF
163 : END IF
164 :
165 94582 : CALL timestop(handle)
166 :
167 94582 : END SUBROUTINE update_particle_set
168 :
169 : ! **************************************************************************************************
170 : !> \brief Return the atomic position or velocity of atom iatom in x from a
171 : !> packed vector even if core-shell particles are present
172 : !> \param iatom ...
173 : !> \param particle_set ...
174 : !> \param vector ...
175 : !> \return ...
176 : !> \date 25.11.2010
177 : !> \author Matthias Krack
178 : !> \version 1.0
179 : ! **************************************************************************************************
180 357014 : PURE FUNCTION get_particle_pos_or_vel(iatom, particle_set, vector) RESULT(x)
181 :
182 : INTEGER, INTENT(IN) :: iatom
183 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
184 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: vector
185 : REAL(KIND=dp), DIMENSION(3) :: x
186 :
187 : INTEGER :: ic, is
188 : REAL(KIND=dp) :: fc, fs, mass
189 :
190 357014 : ic = 3*(iatom - 1)
191 357014 : IF (particle_set(iatom)%shell_index == 0) THEN
192 737216 : x(1:3) = vector(ic + 1:ic + 3)
193 : ELSE
194 172710 : is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
195 172710 : mass = particle_set(iatom)%atomic_kind%mass
196 172710 : fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
197 172710 : fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
198 690840 : x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
199 : END IF
200 :
201 357014 : END FUNCTION get_particle_pos_or_vel
202 :
203 : ! **************************************************************************************************
204 : !> \brief Update the atomic position or velocity by x and return the updated
205 : !> atomic position or velocity in x even if core-shell particles are
206 : !> present
207 : !> \param iatom ...
208 : !> \param particle_set ...
209 : !> \param x ...
210 : !> \param vector ...
211 : !> \date 26.11.2010
212 : !> \author Matthias Krack
213 : !> \version 1.0
214 : !> \note particle-set is not changed, only the positions or velocities in
215 : !> the packed vector are updated
216 : ! **************************************************************************************************
217 1020 : PURE SUBROUTINE update_particle_pos_or_vel(iatom, particle_set, x, vector)
218 :
219 : INTEGER, INTENT(IN) :: iatom
220 : TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set
221 : REAL(KIND=dp), DIMENSION(3), INTENT(INOUT) :: x
222 : REAL(KIND=dp), DIMENSION(:), INTENT(INOUT) :: vector
223 :
224 : INTEGER :: ic, is
225 : REAL(KIND=dp) :: fc, fs, mass
226 :
227 1020 : ic = 3*(iatom - 1)
228 1020 : IF (particle_set(iatom)%shell_index == 0) THEN
229 4080 : vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
230 4080 : x(1:3) = vector(ic + 1:ic + 3)
231 : ELSE
232 0 : is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
233 0 : mass = particle_set(iatom)%atomic_kind%mass
234 0 : fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
235 0 : fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
236 0 : vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
237 0 : vector(is + 1:is + 3) = vector(is + 1:is + 3) + x(1:3)
238 0 : x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
239 : END IF
240 :
241 1020 : END SUBROUTINE update_particle_pos_or_vel
242 :
243 0 : END MODULE particle_types
|
