Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Types to describe group distributions
10 : !> \par History
11 : !> 2019.03 created [Frederick Stein]
12 : !> \author Frederick Stein
13 : ! **************************************************************************************************
14 : MODULE group_dist_types
15 : USE message_passing, ONLY: mp_comm_type
16 : USE util, ONLY: get_limit
17 : #include "./base/base_uses.f90"
18 :
19 : IMPLICIT NONE
20 :
21 : PRIVATE
22 :
23 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'group_dist_types'
24 :
25 : PUBLIC :: group_dist_d0_type, group_dist_d1_type, &
26 : create_group_dist, get_group_dist, release_group_dist, maxsize, group_dist_proc
27 :
28 : ! Type to represent start, end and size of one group (usually the own group)
29 : TYPE group_dist_d0_type
30 : INTEGER :: starts = -1, ends = -1, sizes = -1
31 : END TYPE group_dist_d0_type
32 :
33 : ! Class to represent 1d-sets of starts, ends and sizes of all groups
34 : ! Better for exchanging information than using arrays of group_dist_d0_type
35 : TYPE group_dist_d1_type
36 : INTEGER, ALLOCATABLE, DIMENSION(:) :: starts, ends, sizes
37 : END TYPE group_dist_d1_type
38 :
39 : INTERFACE create_group_dist
40 : MODULE PROCEDURE create_group_dist_d0, &
41 : create_group_dist_d1_i1, &
42 : create_group_dist_d1_i3, &
43 : create_group_dist_d1_gd, &
44 : create_group_dist_d1_0
45 : END INTERFACE create_group_dist
46 :
47 : INTERFACE get_group_dist
48 : MODULE PROCEDURE get_group_dist_d0, &
49 : get_group_dist_d1, &
50 : get_group_dist_gd1
51 : END INTERFACE
52 :
53 : INTERFACE release_group_dist
54 : MODULE PROCEDURE release_group_dist_d1
55 : END INTERFACE release_group_dist
56 :
57 : CONTAINS
58 :
59 : ! **************************************************************************************************
60 : !> \brief ...
61 : !> \param this ...
62 : !> \param ngroups ...
63 : !> \param dimen ...
64 : !> \param pos ...
65 : ! **************************************************************************************************
66 0 : PURE SUBROUTINE create_group_dist_d0(this, ngroups, dimen, pos)
67 : TYPE(group_dist_d0_type), INTENT(INOUT) :: this
68 : INTEGER, INTENT(IN) :: ngroups, dimen, pos
69 :
70 : INTEGER, DIMENSION(2) :: itmp
71 :
72 0 : itmp = get_limit(dimen, ngroups, pos)
73 0 : this%starts = itmp(1)
74 0 : this%ends = itmp(2)
75 0 : this%sizes = itmp(2) - itmp(1) + 1
76 :
77 0 : END SUBROUTINE create_group_dist_d0
78 :
79 : ! **************************************************************************************************
80 : !> \brief ...
81 : !> \param this ...
82 : !> \param ngroups ...
83 : !> \param dimen ...
84 : ! **************************************************************************************************
85 2916 : PURE SUBROUTINE create_group_dist_d1_i1(this, ngroups, dimen)
86 : TYPE(group_dist_d1_type), INTENT(INOUT) :: this
87 : INTEGER, INTENT(IN) :: ngroups, dimen
88 :
89 : INTEGER :: iproc
90 : INTEGER, DIMENSION(2) :: itmp
91 :
92 8748 : ALLOCATE (this%starts(0:ngroups - 1))
93 6640 : this%starts = 0
94 8748 : ALLOCATE (this%ends(0:ngroups - 1))
95 6640 : this%ends = 0
96 8748 : ALLOCATE (this%sizes(0:ngroups - 1))
97 6640 : this%sizes = 0
98 :
99 6640 : DO iproc = 0, ngroups - 1
100 3724 : itmp = get_limit(dimen, ngroups, iproc)
101 3724 : this%starts(iproc) = itmp(1)
102 3724 : this%ends(iproc) = itmp(2)
103 6640 : this%sizes(iproc) = itmp(2) - itmp(1) + 1
104 : END DO
105 :
106 2916 : END SUBROUTINE create_group_dist_d1_i1
107 :
108 : ! **************************************************************************************************
109 : !> \brief ...
110 : !> \param this ...
111 : !> \param ngroups ...
112 : ! **************************************************************************************************
113 986 : PURE SUBROUTINE create_group_dist_d1_0(this, ngroups)
114 : TYPE(group_dist_d1_type), INTENT(INOUT) :: this
115 : INTEGER, INTENT(IN) :: ngroups
116 :
117 2958 : ALLOCATE (this%starts(0:ngroups - 1))
118 2958 : this%starts = 0
119 2958 : ALLOCATE (this%ends(0:ngroups - 1))
120 2958 : this%ends = 0
121 2958 : ALLOCATE (this%sizes(0:ngroups - 1))
122 2958 : this%sizes = 0
123 :
124 986 : END SUBROUTINE create_group_dist_d1_0
125 :
126 : ! **************************************************************************************************
127 : !> \brief ...
128 : !> \param this ...
129 : !> \param starts ...
130 : !> \param ends ...
131 : !> \param sizes ...
132 : !> \param comm ...
133 : ! **************************************************************************************************
134 1206 : SUBROUTINE create_group_dist_d1_i3(this, starts, ends, sizes, comm)
135 : TYPE(group_dist_d1_type), INTENT(INOUT) :: this
136 : INTEGER, INTENT(IN) :: starts, ends, sizes
137 :
138 : CLASS(mp_comm_type), INTENT(IN) :: comm
139 :
140 : CHARACTER(LEN=*), PARAMETER :: routineN = 'create_group_dist_d1_i3'
141 :
142 : INTEGER :: handle
143 :
144 1206 : CALL timeset(routineN, handle)
145 :
146 3618 : ALLOCATE (this%starts(0:comm%num_pe - 1))
147 3618 : ALLOCATE (this%ends(0:comm%num_pe - 1))
148 3618 : ALLOCATE (this%sizes(0:comm%num_pe - 1))
149 :
150 1206 : CALL comm%allgather(starts, this%starts)
151 1206 : CALL comm%allgather(ends, this%ends)
152 1206 : CALL comm%allgather(sizes, this%sizes)
153 :
154 1206 : CALL timestop(handle)
155 :
156 1206 : END SUBROUTINE create_group_dist_d1_i3
157 :
158 : ! **************************************************************************************************
159 : !> \brief ...
160 : !> \param this ...
161 : !> \param group_dist_ext ...
162 : !> \param comm ...
163 : ! **************************************************************************************************
164 0 : SUBROUTINE create_group_dist_d1_gd(this, group_dist_ext, comm)
165 : TYPE(group_dist_d1_type), INTENT(INOUT) :: this
166 : TYPE(group_dist_d0_type), INTENT(IN) :: group_dist_ext
167 :
168 : CLASS(mp_comm_type), INTENT(IN) :: comm
169 :
170 : CHARACTER(LEN=*), PARAMETER :: routineN = 'create_group_dist_d1_gd'
171 :
172 : INTEGER :: handle
173 :
174 0 : CALL timeset(routineN, handle)
175 :
176 0 : ALLOCATE (this%starts(0:comm%num_pe - 1))
177 0 : ALLOCATE (this%ends(0:comm%num_pe - 1))
178 0 : ALLOCATE (this%sizes(0:comm%num_pe - 1))
179 :
180 0 : CALL comm%allgather(group_dist_ext%starts, this%starts)
181 0 : CALL comm%allgather(group_dist_ext%ends, this%ends)
182 0 : CALL comm%allgather(group_dist_ext%sizes, this%sizes)
183 :
184 0 : CALL timestop(handle)
185 :
186 0 : END SUBROUTINE create_group_dist_d1_gd
187 :
188 : ! **************************************************************************************************
189 : !> \brief ...
190 : !> \param this ...
191 : !> \param starts ...
192 : !> \param ends ...
193 : !> \param sizes ...
194 : ! **************************************************************************************************
195 0 : PURE SUBROUTINE get_group_dist_d0(this, starts, ends, sizes)
196 : TYPE(group_dist_d0_type), INTENT(IN) :: this
197 : INTEGER, INTENT(OUT), OPTIONAL :: starts, ends, sizes
198 :
199 0 : IF (PRESENT(starts)) starts = this%starts
200 0 : IF (PRESENT(ends)) ends = this%ends
201 0 : IF (PRESENT(sizes)) sizes = this%sizes
202 :
203 0 : END SUBROUTINE get_group_dist_d0
204 :
205 : ! **************************************************************************************************
206 : !> \brief ...
207 : !> \param this ...
208 : !> \param pos ...
209 : !> \param starts ...
210 : !> \param ends ...
211 : !> \param sizes ...
212 : !> \param group_dist_ext ...
213 : ! **************************************************************************************************
214 11710 : PURE SUBROUTINE get_group_dist_d1(this, pos, starts, ends, sizes, group_dist_ext)
215 : TYPE(group_dist_d1_type), INTENT(IN) :: this
216 : INTEGER, INTENT(IN) :: pos
217 : INTEGER, INTENT(OUT), OPTIONAL :: starts, ends, sizes
218 : TYPE(group_dist_d0_type), INTENT(OUT), OPTIONAL :: group_dist_ext
219 :
220 11710 : IF (PRESENT(starts)) starts = this%starts(pos)
221 11710 : IF (PRESENT(ends)) ends = this%ends(pos)
222 11710 : IF (PRESENT(sizes)) sizes = this%sizes(pos)
223 :
224 11710 : IF (PRESENT(group_dist_ext)) THEN
225 0 : group_dist_ext%starts = this%starts(pos)
226 0 : group_dist_ext%ends = this%ends(pos)
227 0 : group_dist_ext%sizes = this%sizes(pos)
228 : END IF
229 :
230 11710 : END SUBROUTINE get_group_dist_d1
231 :
232 : ! **************************************************************************************************
233 : !> \brief ...
234 : !> \param this ...
235 : !> \param pos ...
236 : !> \param group_dist_ext ...
237 : !> \param pos_ext ...
238 : ! **************************************************************************************************
239 1972 : PURE SUBROUTINE get_group_dist_gd1(this, pos, group_dist_ext, pos_ext)
240 : TYPE(group_dist_d1_type), INTENT(IN) :: this
241 : INTEGER, INTENT(IN) :: pos
242 : TYPE(group_dist_d1_type), INTENT(INOUT) :: group_dist_ext
243 : INTEGER, INTENT(IN) :: pos_ext
244 :
245 1972 : group_dist_ext%starts(pos_ext) = this%starts(pos)
246 1972 : group_dist_ext%ends(pos_ext) = this%ends(pos)
247 1972 : group_dist_ext%sizes(pos_ext) = this%sizes(pos)
248 :
249 1972 : END SUBROUTINE get_group_dist_gd1
250 :
251 : ! **************************************************************************************************
252 : !> \brief ...
253 : !> \param this ...
254 : ! **************************************************************************************************
255 5228 : PURE SUBROUTINE release_group_dist_d1(this)
256 : TYPE(group_dist_d1_type), INTENT(INOUT) :: this
257 :
258 5228 : IF (ALLOCATED(this%starts)) DEALLOCATE (this%starts)
259 5228 : IF (ALLOCATED(this%ends)) DEALLOCATE (this%ends)
260 5228 : IF (ALLOCATED(this%sizes)) DEALLOCATE (this%sizes)
261 :
262 5228 : END SUBROUTINE release_group_dist_d1
263 :
264 : ! **************************************************************************************************
265 : !> \brief ...
266 : !> \param this ...
267 : !> \return ...
268 : ! **************************************************************************************************
269 10284 : ELEMENTAL FUNCTION maxsize(this) RESULT(res)
270 : TYPE(group_dist_d1_type), INTENT(IN) :: this
271 : INTEGER :: res
272 :
273 21480 : res = MAXVAL(this%sizes)
274 :
275 10284 : END FUNCTION maxsize
276 :
277 : ! **************************************************************************************************
278 : !> \brief ...
279 : !> \param this ...
280 : !> \param pos ...
281 : !> \return ...
282 : ! **************************************************************************************************
283 50509 : ELEMENTAL FUNCTION group_dist_proc(this, pos) RESULT(proc)
284 : TYPE(group_dist_d1_type), INTENT(IN) :: this
285 : INTEGER, INTENT(IN) :: pos
286 : INTEGER :: proc
287 :
288 : INTEGER :: p
289 :
290 50509 : proc = -1
291 51246 : DO p = 0, SIZE(this%sizes) - 1
292 51246 : IF (pos <= this%ends(p) .AND. pos >= this%starts(p)) THEN
293 50509 : proc = p
294 : RETURN
295 : END IF
296 : END DO
297 :
298 : END FUNCTION group_dist_proc
299 :
300 0 : END MODULE group_dist_types
|
