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 methods to split tall-and-skinny matrices along longest dimension.
10 : !> Basically, we are splitting process grid and each subgrid holds its own DBM matrix.
11 : !> \author Patrick Seewald
12 : ! **************************************************************************************************
13 : MODULE dbt_tas_split
14 : USE dbt_tas_global, ONLY: dbt_tas_distribution
15 : USE dbt_tas_types, ONLY: dbt_tas_distribution_type,&
16 : dbt_tas_split_info
17 : USE kinds, ONLY: dp,&
18 : int_8
19 : USE message_passing, ONLY: mp_cart_type,&
20 : mp_comm_type,&
21 : mp_dims_create
22 : USE util, ONLY: sort
23 : #include "../../base/base_uses.f90"
24 :
25 : IMPLICIT NONE
26 : PRIVATE
27 :
28 : PUBLIC :: &
29 : dbt_index_global_to_local, &
30 : dbt_index_local_to_global, &
31 : colsplit, &
32 : dbt_tas_get_split_info, &
33 : dbt_tas_info_hold, &
34 : dbt_tas_mp_comm, &
35 : dbt_tas_mp_dims, &
36 : dbt_tas_release_info, &
37 : dbt_tas_create_split, &
38 : dbt_tas_create_split_rows_or_cols, &
39 : dbt_tas_set_strict_split, &
40 : group_to_mrowcol, &
41 : group_to_world_proc_map, &
42 : rowsplit, &
43 : world_to_group_proc_map, &
44 : accept_pgrid_dims, &
45 : default_nsplit_accept_ratio, &
46 : default_pdims_accept_ratio
47 :
48 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_tas_split'
49 :
50 : INTEGER, PARAMETER :: rowsplit = 1, colsplit = 2
51 : REAL(dp), PARAMETER :: default_pdims_accept_ratio = 1.2_dp
52 : REAL(dp), PARAMETER :: default_nsplit_accept_ratio = 3.0_dp
53 :
54 : INTERFACE dbt_tas_mp_comm
55 : MODULE PROCEDURE dbt_tas_mp_comm
56 : MODULE PROCEDURE dbt_tas_mp_comm_from_matrix_sizes
57 : END INTERFACE
58 :
59 : CONTAINS
60 :
61 : ! **************************************************************************************************
62 : !> \brief split mpi grid by rows or columns
63 : !> \param split_info ...
64 : !> \param mp_comm global mpi communicator with a 2d cartesian grid
65 : !> \param ngroup number of groups
66 : !> \param igroup my group ID
67 : !> \param split_rowcol split rows or columns
68 : !> \param own_comm Whether split_info should own communicator
69 : !> \author Patrick Seewald
70 : ! **************************************************************************************************
71 4815678 : SUBROUTINE dbt_tas_create_split_rows_or_cols(split_info, mp_comm, ngroup, igroup, split_rowcol, own_comm)
72 : TYPE(dbt_tas_split_info), INTENT(OUT) :: split_info
73 : TYPE(mp_cart_type), INTENT(IN) :: mp_comm
74 : INTEGER, INTENT(INOUT) :: ngroup
75 : INTEGER, INTENT(IN) :: igroup, split_rowcol
76 : LOGICAL, INTENT(IN), OPTIONAL :: own_comm
77 :
78 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_create_split_rows_or_cols'
79 :
80 : INTEGER :: handle, igroup_check, iproc, &
81 : iproc_group, iproc_group_check, &
82 : numproc_group
83 : INTEGER, DIMENSION(2) :: pdims, pdims_group
84 : LOGICAL :: own_comm_prv, to_assert
85 : TYPE(mp_comm_type) :: mp_comm_group
86 :
87 687954 : CALL timeset(routineN, handle)
88 :
89 687954 : IF (PRESENT(own_comm)) THEN
90 152436 : own_comm_prv = own_comm
91 : ELSE
92 : own_comm_prv = .FALSE.
93 : END IF
94 :
95 152436 : IF (own_comm_prv) THEN
96 152436 : split_info%mp_comm = mp_comm
97 : ELSE
98 535518 : CALL split_info%mp_comm%from_dup(mp_comm)
99 : END IF
100 :
101 687954 : split_info%igroup = igroup
102 687954 : split_info%split_rowcol = split_rowcol
103 :
104 687954 : CALL mp_comm_group%from_split(mp_comm, igroup)
105 :
106 687954 : iproc = mp_comm%mepos
107 2063862 : pdims = mp_comm%num_pe_cart
108 2063862 : split_info%pdims = pdims
109 :
110 687954 : numproc_group = mp_comm_group%num_pe
111 687954 : iproc_group = mp_comm_group%mepos
112 :
113 687954 : IF (iproc == 0) THEN
114 452593 : to_assert = MOD(numproc_group, pdims(MOD(split_rowcol, 2) + 1)) == 0
115 452593 : CPASSERT(to_assert)
116 452593 : split_info%pgrid_split_size = numproc_group/pdims(MOD(split_rowcol, 2) + 1)
117 : END IF
118 687954 : CALL split_info%mp_comm%bcast(split_info%pgrid_split_size, 0)
119 :
120 687954 : ngroup = (pdims(split_rowcol) + split_info%pgrid_split_size - 1)/split_info%pgrid_split_size
121 687954 : split_info%ngroup = ngroup
122 687954 : split_info%group_size = split_info%pgrid_split_size*pdims(MOD(split_rowcol, 2) + 1)
123 :
124 687954 : CALL world_to_group_proc_map(iproc, pdims, split_rowcol, split_info%pgrid_split_size, igroup_check, pdims_group, iproc_group)
125 :
126 687954 : IF (igroup_check .NE. split_info%igroup) THEN
127 0 : CPABORT('inconsistent subgroups')
128 : END IF
129 :
130 687954 : CALL split_info%mp_comm_group%create(mp_comm_group, 2, pdims_group)
131 :
132 687954 : iproc_group_check = split_info%mp_comm_group%mepos
133 :
134 687954 : CPASSERT(iproc_group_check .EQ. iproc_group)
135 :
136 687954 : CALL mp_comm_group%free()
137 :
138 687954 : ALLOCATE (split_info%refcount)
139 687954 : split_info%refcount = 1
140 :
141 687954 : CALL timestop(handle)
142 :
143 687954 : END SUBROUTINE
144 :
145 : ! **************************************************************************************************
146 : !> \brief Create default cartesian process grid that is consistent with default split heuristic
147 : !> of dbt_tas_create_split
148 : !> \param mp_comm ...
149 : !> \param split_rowcol ...
150 : !> \param nsplit ...
151 : !> \return new communicator
152 : !> \author Patrick Seewald
153 : ! **************************************************************************************************
154 166903 : FUNCTION dbt_tas_mp_comm(mp_comm, split_rowcol, nsplit)
155 : CLASS(mp_comm_type), INTENT(IN) :: mp_comm
156 : INTEGER, INTENT(IN) :: split_rowcol, nsplit
157 : TYPE(mp_cart_type) :: dbt_tas_mp_comm
158 :
159 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_mp_comm'
160 :
161 : INTEGER :: handle, numproc
162 : INTEGER, DIMENSION(2) :: npdims
163 :
164 166903 : CALL timeset(routineN, handle)
165 :
166 166903 : numproc = mp_comm%num_pe
167 :
168 166903 : npdims = dbt_tas_mp_dims(numproc, split_rowcol, nsplit)
169 :
170 166903 : CALL dbt_tas_mp_comm%create(mp_comm, 2, npdims)
171 :
172 166903 : CALL timestop(handle)
173 166903 : END FUNCTION
174 :
175 : ! **************************************************************************************************
176 : !> \brief Get optimal process grid dimensions consistent with dbt_tas_create_split
177 : !> \param numproc ...
178 : !> \param split_rowcol ...
179 : !> \param nsplit ...
180 : !> \return ...
181 : !> \author Patrick Seewald
182 : ! **************************************************************************************************
183 166903 : FUNCTION dbt_tas_mp_dims(numproc, split_rowcol, nsplit)
184 : INTEGER, INTENT(IN) :: numproc, split_rowcol, nsplit
185 : INTEGER, DIMENSION(2) :: dbt_tas_mp_dims
186 :
187 : INTEGER :: group_size, nsplit_opt
188 : INTEGER, DIMENSION(2) :: group_dims
189 :
190 166903 : nsplit_opt = get_opt_nsplit(numproc, nsplit, split_pgrid=.FALSE.)
191 :
192 166903 : group_size = numproc/nsplit_opt
193 166903 : group_dims(:) = 0
194 :
195 166903 : CALL mp_dims_create(group_size, group_dims)
196 :
197 : ! here we choose order of group dims s.t. a split factor < nsplit_opt is favoured w.r.t.
198 : ! optimal subgrid dimensions
199 278871 : SELECT CASE (split_rowcol)
200 : CASE (rowsplit)
201 783776 : group_dims = [MINVAL(group_dims), MAXVAL(group_dims)]
202 : CASE (colsplit)
203 496513 : group_dims = [MAXVAL(group_dims), MINVAL(group_dims)]
204 : END SELECT
205 :
206 111968 : SELECT CASE (split_rowcol)
207 : CASE (rowsplit)
208 335904 : dbt_tas_mp_dims(:) = [group_dims(1)*nsplit_opt, group_dims(2)]
209 : CASE (colsplit)
210 276773 : dbt_tas_mp_dims(:) = [group_dims(1), group_dims(2)*nsplit_opt]
211 : END SELECT
212 :
213 : END FUNCTION
214 :
215 : ! **************************************************************************************************
216 : !> \brief Heuristic to get good split factor for a given process grid OR a given number of processes
217 : !> \param numproc total number of processes or (if split_pgrid) process grid dimension to split
218 : !> \param nsplit Desired split factor
219 : !> \param split_pgrid whether to split process grid
220 : !> \param pdim_nonsplit if split_pgrid: other process grid dimension
221 : !> \return split factor consistent with process grid or number of processes
222 : !> \param
223 : !> \author Patrick Seewald
224 : ! **************************************************************************************************
225 451921 : FUNCTION get_opt_nsplit(numproc, nsplit, split_pgrid, pdim_nonsplit)
226 : INTEGER, INTENT(IN) :: numproc, nsplit
227 : LOGICAL, INTENT(IN) :: split_pgrid
228 : INTEGER, INTENT(IN), OPTIONAL :: pdim_nonsplit
229 : INTEGER :: get_opt_nsplit
230 :
231 : INTEGER :: count, count_accept, count_square, lb, &
232 : minpos, split, ub
233 451921 : INTEGER, ALLOCATABLE, DIMENSION(:) :: nsplit_list, nsplit_list_accept, &
234 451921 : nsplit_list_square
235 : INTEGER, DIMENSION(2) :: dims_sub
236 :
237 451921 : CPASSERT(nsplit > 0)
238 :
239 451921 : IF (split_pgrid) THEN
240 285018 : CPASSERT(PRESENT(pdim_nonsplit))
241 : END IF
242 :
243 451921 : lb = CEILING(REAL(nsplit, dp)/default_nsplit_accept_ratio)
244 451921 : ub = FLOOR(REAL(nsplit, dp)*default_nsplit_accept_ratio)
245 :
246 451921 : IF (ub < lb) ub = lb
247 :
248 2259605 : ALLOCATE (nsplit_list(1:ub - lb + 1), nsplit_list_square(1:ub - lb + 1), nsplit_list_accept(1:ub - lb + 1))
249 3668454 : count = 0
250 3668454 : count_square = 0
251 3668454 : count_accept = 0
252 3668454 : DO split = lb, ub
253 3668454 : IF (MOD(numproc, split) == 0) THEN
254 738557 : count = count + 1
255 738557 : nsplit_list(count) = split
256 :
257 738557 : dims_sub = 0
258 738557 : IF (.NOT. split_pgrid) THEN
259 285151 : CALL mp_dims_create(numproc/split, dims_sub)
260 : ELSE
261 1360218 : dims_sub = [numproc/split, pdim_nonsplit]
262 : END IF
263 :
264 738557 : IF (dims_sub(1) == dims_sub(2)) THEN
265 430233 : count_square = count_square + 1
266 430233 : nsplit_list_square(count_square) = split
267 430233 : count_accept = count_accept + 1
268 430233 : nsplit_list_accept(count_accept) = split
269 308324 : ELSEIF (accept_pgrid_dims(dims_sub, relative=.FALSE.)) THEN
270 0 : count_accept = count_accept + 1
271 0 : nsplit_list_accept(count_accept) = split
272 : END IF
273 :
274 : END IF
275 : END DO
276 :
277 451921 : IF (count_square > 0) THEN
278 1290699 : minpos = MINLOC(ABS(nsplit_list_square(1:count_square) - nsplit), DIM=1)
279 430233 : get_opt_nsplit = nsplit_list_square(minpos)
280 21688 : ELSEIF (count_accept > 0) THEN
281 0 : minpos = MINLOC(ABS(nsplit_list_accept(1:count_accept) - nsplit), DIM=1)
282 0 : get_opt_nsplit = nsplit_list_accept(minpos)
283 21688 : ELSEIF (count > 0) THEN
284 51174 : minpos = MINLOC(ABS(nsplit_list(1:count) - nsplit), DIM=1)
285 17058 : get_opt_nsplit = nsplit_list(minpos)
286 : ELSE
287 : get_opt_nsplit = nsplit
288 415334 : DO WHILE (MOD(numproc, get_opt_nsplit) .NE. 0)
289 410704 : get_opt_nsplit = get_opt_nsplit - 1
290 : END DO
291 : END IF
292 :
293 451921 : END FUNCTION
294 :
295 : ! **************************************************************************************************
296 : !> \brief Derive optimal cartesian process grid from matrix sizes. This ensures optimality for
297 : !> dense matrices only
298 : !> \param mp_comm ...
299 : !> \param nblkrows total number of block rows
300 : !> \param nblkcols total number of block columns
301 : !> \return MPI communicator
302 : !> \author Patrick Seewald
303 : ! **************************************************************************************************
304 14419 : FUNCTION dbt_tas_mp_comm_from_matrix_sizes(mp_comm, nblkrows, nblkcols) RESULT(mp_comm_new)
305 : CLASS(mp_comm_type), INTENT(IN) :: mp_comm
306 : INTEGER(KIND=int_8), INTENT(IN) :: nblkrows, nblkcols
307 : TYPE(mp_cart_type) :: mp_comm_new
308 :
309 : INTEGER :: nsplit, split_rowcol
310 :
311 14419 : IF (nblkrows >= nblkcols) THEN
312 14413 : split_rowcol = rowsplit
313 14413 : nsplit = INT((nblkrows - 1)/nblkcols + 1)
314 : ELSE
315 6 : split_rowcol = colsplit
316 6 : nsplit = INT((nblkcols - 1)/nblkrows + 1)
317 : END IF
318 :
319 14419 : mp_comm_new = dbt_tas_mp_comm(mp_comm, split_rowcol, nsplit)
320 14419 : END FUNCTION
321 :
322 : ! **************************************************************************************************
323 : !> \brief Split Cartesian process grid using a default split heuristic.
324 : !> \param split_info object storing all data corresponding to split, submatrices and parallelization
325 : !> \param mp_comm MPI communicator with associated cartesian grid
326 : !> \param split_rowcol split rows or columns
327 : !> \param nsplit desired split factor, set to 0 if split factor of exactly 1 is required
328 : !> \param own_comm whether split_info should own communicator
329 : !> \param opt_nsplit whether nsplit should be optimized to process grid
330 : !> \author Patrick Seewald
331 : ! **************************************************************************************************
332 4815678 : SUBROUTINE dbt_tas_create_split(split_info, mp_comm, split_rowcol, nsplit, own_comm, opt_nsplit)
333 : TYPE(dbt_tas_split_info), INTENT(OUT) :: split_info
334 : TYPE(mp_cart_type), INTENT(IN) :: mp_comm
335 : INTEGER, INTENT(IN) :: split_rowcol, nsplit
336 : LOGICAL, INTENT(IN), OPTIONAL :: own_comm, opt_nsplit
337 :
338 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_create_split'
339 :
340 : INTEGER :: handle, igroup, iproc, nsplit_opt, &
341 : pdim_nonsplit, pdim_split
342 : INTEGER, DIMENSION(2) :: pcoord, pdims, pdims_group
343 : LOGICAL :: opt_nsplit_prv
344 :
345 687954 : CALL timeset(routineN, handle)
346 :
347 687954 : IF (PRESENT(opt_nsplit)) THEN
348 535470 : opt_nsplit_prv = opt_nsplit
349 : ELSE
350 : opt_nsplit_prv = .TRUE.
351 : END IF
352 :
353 687954 : CPASSERT(nsplit > 0)
354 :
355 687954 : iproc = mp_comm%mepos
356 2063862 : pdims = mp_comm%num_pe_cart
357 2063862 : pcoord = mp_comm%mepos_cart
358 :
359 1211177 : SELECT CASE (split_rowcol)
360 : CASE (rowsplit)
361 523223 : pdim_split = pdims(1)
362 523223 : pdim_nonsplit = pdims(2)
363 : CASE (colsplit)
364 164731 : pdim_split = pdims(2)
365 687954 : pdim_nonsplit = pdims(1)
366 : END SELECT
367 :
368 687954 : IF (opt_nsplit_prv) THEN
369 285018 : nsplit_opt = get_opt_nsplit(pdim_split, nsplit, split_pgrid=.TRUE., pdim_nonsplit=pdim_nonsplit)
370 : ELSE
371 402936 : IF (MOD(pdims(split_rowcol), nsplit) .NE. 0) THEN
372 0 : CPABORT("Split factor does not divide process grid dimension")
373 : END IF
374 402936 : nsplit_opt = nsplit
375 : END IF
376 :
377 687954 : pdims_group = pdims
378 687954 : pdims_group(split_rowcol) = pdims_group(split_rowcol)/nsplit_opt
379 :
380 687954 : igroup = pcoord(split_rowcol)/pdims_group(split_rowcol)
381 :
382 687954 : CALL dbt_tas_create_split_rows_or_cols(split_info, mp_comm, nsplit_opt, igroup, split_rowcol, own_comm=own_comm)
383 :
384 687954 : IF (nsplit > 0) THEN
385 687954 : ALLOCATE (split_info%ngroup_opt, SOURCE=nsplit)
386 : END IF
387 :
388 687954 : CALL timestop(handle)
389 :
390 687954 : END SUBROUTINE
391 :
392 : ! **************************************************************************************************
393 : !> \brief Whether to accept proposed process grid dimensions (based on ratio of dimensions)
394 : !> \param dims ...
395 : !> \param relative ...
396 : !> \return ...
397 : !> \author Patrick Seewald
398 : ! **************************************************************************************************
399 516782 : FUNCTION accept_pgrid_dims(dims, relative)
400 : INTEGER, DIMENSION(2), INTENT(IN) :: dims
401 : LOGICAL, INTENT(IN) :: relative
402 : LOGICAL :: accept_pgrid_dims
403 :
404 : INTEGER, DIMENSION(2) :: dims_opt
405 :
406 516782 : IF (relative) THEN
407 208458 : dims_opt = 0
408 625374 : CALL mp_dims_create(PRODUCT(dims), dims_opt)
409 1250748 : accept_pgrid_dims = (MAXVAL(REAL(dims, dp))/MAXVAL(dims_opt) .LT. default_pdims_accept_ratio)
410 : ELSE
411 1849944 : accept_pgrid_dims = (MAXVAL(REAL(dims, dp))/MINVAL(dims) .LT. default_pdims_accept_ratio**2)
412 : END IF
413 516782 : END FUNCTION
414 :
415 : ! **************************************************************************************************
416 : !> \brief Get info on split
417 : !> \param info ...
418 : !> \param mp_comm communicator (global process grid)
419 : !> \param nsplit split factor
420 : !> \param igroup which group do I belong to
421 : !> \param mp_comm_group subgroup communicator (group-local process grid)
422 : !> \param split_rowcol split rows or columns
423 : !> \param pgrid_offset group-local offset in process grid
424 : !> \author Patrick Seewald
425 : ! **************************************************************************************************
426 2546434 : SUBROUTINE dbt_tas_get_split_info(info, mp_comm, nsplit, igroup, mp_comm_group, split_rowcol, pgrid_offset)
427 : TYPE(dbt_tas_split_info), INTENT(IN) :: info
428 : TYPE(mp_cart_type), INTENT(OUT), OPTIONAL :: mp_comm
429 : INTEGER, INTENT(OUT), OPTIONAL :: nsplit, igroup
430 : TYPE(mp_cart_type), INTENT(OUT), OPTIONAL :: mp_comm_group
431 : INTEGER, INTENT(OUT), OPTIONAL :: split_rowcol
432 : INTEGER, DIMENSION(2), INTENT(OUT), OPTIONAL :: pgrid_offset
433 :
434 2546434 : IF (PRESENT(mp_comm)) mp_comm = info%mp_comm
435 2546434 : IF (PRESENT(mp_comm_group)) mp_comm_group = info%mp_comm_group
436 2546434 : IF (PRESENT(split_rowcol)) split_rowcol = info%split_rowcol
437 2546434 : IF (PRESENT(igroup)) igroup = info%igroup
438 2546434 : IF (PRESENT(nsplit)) nsplit = info%ngroup
439 :
440 2546434 : IF (PRESENT(pgrid_offset)) THEN
441 92790 : SELECT CASE (info%split_rowcol)
442 : CASE (rowsplit)
443 121878 : pgrid_offset(:) = [info%igroup*info%pgrid_split_size, 0]
444 : CASE (colsplit)
445 75240 : pgrid_offset(:) = [0, info%igroup*info%pgrid_split_size]
446 : END SELECT
447 : END IF
448 :
449 2546434 : END SUBROUTINE
450 :
451 : ! **************************************************************************************************
452 : !> \brief ...
453 : !> \param split_info ...
454 : !> \author Patrick Seewald
455 : ! **************************************************************************************************
456 2999059 : SUBROUTINE dbt_tas_release_info(split_info)
457 : TYPE(dbt_tas_split_info), INTENT(INOUT) :: split_info
458 :
459 : LOGICAL :: abort
460 :
461 2999059 : abort = .FALSE.
462 :
463 2999059 : IF (.NOT. ASSOCIATED(split_info%refcount)) THEN
464 : abort = .TRUE.
465 2999059 : ELSEIF (split_info%refcount < 1) THEN
466 : abort = .TRUE.
467 : END IF
468 :
469 : IF (abort) THEN
470 0 : CPABORT("can not destroy non-existing split_info")
471 : END IF
472 :
473 2999059 : split_info%refcount = split_info%refcount - 1
474 :
475 2999059 : IF (split_info%refcount == 0) THEN
476 687954 : CALL split_info%mp_comm_group%free()
477 687954 : CALL split_info%mp_comm%free()
478 687954 : DEALLOCATE (split_info%refcount)
479 : END IF
480 :
481 8997177 : split_info%pdims = 0
482 :
483 2999059 : IF (ALLOCATED(split_info%ngroup_opt)) DEALLOCATE (split_info%ngroup_opt)
484 2999059 : END SUBROUTINE
485 :
486 : ! **************************************************************************************************
487 : !> \brief ...
488 : !> \param split_info ...
489 : !> \author Patrick Seewald
490 : ! **************************************************************************************************
491 2311105 : SUBROUTINE dbt_tas_info_hold(split_info)
492 : TYPE(dbt_tas_split_info), INTENT(IN) :: split_info
493 :
494 : INTEGER, POINTER :: ref
495 :
496 2311105 : IF (split_info%refcount < 1) THEN
497 0 : CPABORT("can not hold non-existing split_info")
498 : END IF
499 2311105 : ref => split_info%refcount
500 2311105 : ref = ref + 1
501 2311105 : END SUBROUTINE
502 :
503 : ! **************************************************************************************************
504 : !> \brief map global process info to group
505 : !> \param iproc global process ID
506 : !> \param pdims global process dimensions
507 : !> \param split_rowcol split rows or column
508 : !> \param pgrid_split_size how many process rows/cols per group
509 : !> \param igroup group ID
510 : !> \param pdims_group local process grid dimensions
511 : !> \param iproc_group group local process ID
512 : !> \author Patrick Seewald
513 : ! **************************************************************************************************
514 687954 : SUBROUTINE world_to_group_proc_map(iproc, pdims, split_rowcol, pgrid_split_size, igroup, &
515 : pdims_group, iproc_group)
516 : INTEGER, INTENT(IN) :: iproc
517 : INTEGER, DIMENSION(2), INTENT(IN) :: pdims
518 : INTEGER, INTENT(IN) :: split_rowcol, pgrid_split_size
519 : INTEGER, INTENT(OUT) :: igroup
520 : INTEGER, DIMENSION(2), INTENT(OUT), OPTIONAL :: pdims_group
521 : INTEGER, INTENT(OUT), OPTIONAL :: iproc_group
522 :
523 : INTEGER, DIMENSION(2) :: pcoord, pcoord_group
524 :
525 687954 : IF (PRESENT(iproc_group)) THEN
526 687954 : CPASSERT(PRESENT(pdims_group))
527 : END IF
528 :
529 2063862 : pcoord = [iproc/pdims(2), MOD(iproc, pdims(2))]
530 :
531 687954 : igroup = pcoord(split_rowcol)/pgrid_split_size
532 :
533 523223 : SELECT CASE (split_rowcol)
534 : CASE (rowsplit)
535 1569669 : IF (PRESENT(pdims_group)) pdims_group = [pgrid_split_size, pdims(2)]
536 1569669 : IF (PRESENT(iproc_group)) pcoord_group = [MOD(pcoord(1), pgrid_split_size), pcoord(2)]
537 : CASE (colsplit)
538 494193 : IF (PRESENT(pdims_group)) pdims_group = [pdims(1), pgrid_split_size]
539 1182147 : IF (PRESENT(iproc_group)) pcoord_group = [pcoord(1), MOD(pcoord(2), pgrid_split_size)]
540 : END SELECT
541 687954 : IF (PRESENT(iproc_group)) iproc_group = pcoord_group(1)*pdims_group(2) + pcoord_group(2)
542 687954 : END SUBROUTINE
543 :
544 : ! **************************************************************************************************
545 : !> \brief map local process info to global info
546 : !> \param iproc global process id
547 : !> \param pdims global process grid dimensions
548 : !> \param split_rowcol split rows or colum
549 : !> \param pgrid_split_size how many process rows/cols per group
550 : !> \param igroup group ID
551 : !> \param iproc_group local process ID
552 : !> \author Patrick Seewald
553 : ! **************************************************************************************************
554 0 : SUBROUTINE group_to_world_proc_map(iproc, pdims, split_rowcol, pgrid_split_size, &
555 : igroup, iproc_group)
556 : INTEGER, INTENT(OUT) :: iproc
557 : INTEGER, DIMENSION(2), INTENT(IN) :: pdims
558 : INTEGER, INTENT(IN) :: split_rowcol, pgrid_split_size, igroup, &
559 : iproc_group
560 :
561 : INTEGER, DIMENSION(2) :: pcoord, pcoord_group, pdims_group
562 :
563 0 : SELECT CASE (split_rowcol)
564 : CASE (rowsplit)
565 0 : pdims_group = [pgrid_split_size, pdims(2)]
566 : CASE (colsplit)
567 0 : pdims_group = [pdims(1), pgrid_split_size]
568 : END SELECT
569 :
570 0 : pcoord_group = [iproc_group/pdims_group(2), MOD(iproc_group, pdims_group(2))]
571 :
572 0 : SELECT CASE (split_rowcol)
573 : CASE (rowsplit)
574 0 : pcoord = [igroup*pgrid_split_size + pcoord_group(1), pcoord_group(2)]
575 : CASE (colsplit)
576 0 : pcoord = [pcoord_group(1), igroup*pgrid_split_size + pcoord_group(2)]
577 : END SELECT
578 0 : iproc = pcoord(1)*pdims(2) + pcoord(2)
579 0 : END SUBROUTINE
580 :
581 : ! **************************************************************************************************
582 : !> \brief map group local block index to global matrix index
583 : !> \param info ...
584 : !> \param dist ...
585 : !> \param row_group group local row block index
586 : !> \param column_group group local column block index
587 : !> \param row global block row
588 : !> \param column global block column
589 : !> \author Patrick Seewald
590 : ! **************************************************************************************************
591 94025995 : SUBROUTINE dbt_index_local_to_global(info, dist, row_group, column_group, row, column)
592 : TYPE(dbt_tas_split_info), INTENT(IN) :: info
593 : TYPE(dbt_tas_distribution_type), INTENT(IN) :: dist
594 : INTEGER, INTENT(IN), OPTIONAL :: row_group, column_group
595 : INTEGER(KIND=int_8), INTENT(OUT), OPTIONAL :: row, column
596 :
597 132087443 : SELECT CASE (info%split_rowcol)
598 : CASE (rowsplit)
599 38061448 : ASSOCIATE (rows => dist%local_rowcols)
600 38061448 : IF (PRESENT(row)) row = rows(row_group)
601 76122896 : IF (PRESENT(column)) column = column_group
602 : END ASSOCIATE
603 : CASE (colsplit)
604 94025995 : ASSOCIATE (cols => dist%local_rowcols)
605 26828733 : IF (PRESENT(row)) row = row_group
606 82793280 : IF (PRESENT(column)) column = cols(column_group)
607 : END ASSOCIATE
608 : END SELECT
609 94025995 : END SUBROUTINE
610 :
611 : ! **************************************************************************************************
612 : !> \brief map global block index to group local index
613 : !> \param info ...
614 : !> \param dist ...
615 : !> \param row ...
616 : !> \param column ...
617 : !> \param row_group ...
618 : !> \param column_group ...
619 : !> \author Patrick Seewald
620 : ! **************************************************************************************************
621 77794254 : SUBROUTINE dbt_index_global_to_local(info, dist, row, column, row_group, column_group)
622 : TYPE(dbt_tas_split_info), INTENT(IN) :: info
623 : TYPE(dbt_tas_distribution_type), INTENT(IN) :: dist
624 : INTEGER(KIND=int_8), INTENT(IN), OPTIONAL :: row, column
625 : INTEGER, INTENT(OUT), OPTIONAL :: row_group, column_group
626 :
627 116549299 : SELECT CASE (info%split_rowcol)
628 : CASE (rowsplit)
629 38755045 : IF (PRESENT(row_group)) row_group = i8_bsearch(dist%local_rowcols, row)
630 38755045 : IF (PRESENT(column_group)) column_group = INT(column)
631 : CASE (colsplit)
632 39039209 : IF (PRESENT(row_group)) row_group = INT(row)
633 116833463 : IF (PRESENT(column_group)) column_group = i8_bsearch(dist%local_rowcols, column)
634 : END SELECT
635 :
636 77794254 : END SUBROUTINE
637 :
638 : ! **************************************************************************************************
639 : !> \brief binary search for 8-byte integers
640 : !> \param array ...
641 : !> \param el ...
642 : !> \param l_index ...
643 : !> \param u_index ...
644 : !> \return ...
645 : !> \author Patrick Seewald
646 : ! **************************************************************************************************
647 77794254 : FUNCTION i8_bsearch(array, el, l_index, u_index) RESULT(res)
648 : INTEGER(KIND=int_8), INTENT(in) :: array(:), el
649 : INTEGER, INTENT(in), OPTIONAL :: l_index, u_index
650 : INTEGER :: res
651 :
652 : INTEGER :: aindex, lindex, uindex
653 :
654 77794254 : lindex = 1
655 77794254 : uindex = SIZE(array)
656 77794254 : IF (PRESENT(l_index)) lindex = l_index
657 77794254 : IF (PRESENT(u_index)) uindex = u_index
658 555031778 : DO WHILE (lindex <= uindex)
659 477237524 : aindex = (lindex + uindex)/2
660 555031778 : IF (array(aindex) < el) THEN
661 214263204 : lindex = aindex + 1
662 : ELSE
663 262974320 : uindex = aindex - 1
664 : END IF
665 : END DO
666 77794254 : res = lindex
667 77794254 : END FUNCTION
668 :
669 : ! **************************************************************************************************
670 : !> \brief maps a process subgroup to matrix rows/columns
671 : !> \param info ...
672 : !> \param rowcol_dist ...
673 : !> \param igroup group ID
674 : !> \param rowcols rows/ columns on this group
675 : !> \author Patrick Seewald
676 : ! **************************************************************************************************
677 817154 : SUBROUTINE group_to_mrowcol(info, rowcol_dist, igroup, rowcols)
678 : TYPE(dbt_tas_split_info), INTENT(IN) :: info
679 :
680 : CLASS(dbt_tas_distribution), INTENT(IN) :: rowcol_dist
681 : INTEGER, INTENT(IN) :: igroup
682 : INTEGER(KIND=int_8), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: rowcols
683 1634308 : INTEGER, DIMENSION(0:info%pgrid_split_size - 1) :: nrowcols_group
684 : INTEGER :: pcoord, nrowcols, count, pcoord_group
685 817154 : INTEGER, DIMENSION(:), ALLOCATABLE :: sort_indices
686 :
687 1733618 : nrowcols_group(:) = 0
688 1733618 : DO pcoord = igroup*info%pgrid_split_size, (igroup + 1)*info%pgrid_split_size - 1
689 916464 : pcoord_group = pcoord - igroup*info%pgrid_split_size
690 1733618 : nrowcols_group(pcoord_group) = SIZE(rowcol_dist%rowcols(pcoord))
691 : END DO
692 1733618 : nrowcols = SUM(nrowcols_group)
693 :
694 2448591 : ALLOCATE (rowcols(nrowcols))
695 :
696 817154 : count = 0
697 1733618 : DO pcoord = igroup*info%pgrid_split_size, (igroup + 1)*info%pgrid_split_size - 1
698 916464 : pcoord_group = pcoord - igroup*info%pgrid_split_size
699 14948250 : rowcols(count + 1:count + nrowcols_group(pcoord_group)) = rowcol_dist%rowcols(pcoord)
700 1733618 : count = count + nrowcols_group(pcoord_group)
701 : END DO
702 :
703 2448591 : ALLOCATE (sort_indices(nrowcols))
704 817154 : CALL sort(rowcols, nrowcols, sort_indices)
705 817154 : END SUBROUTINE
706 :
707 : ! **************************************************************************************************
708 : !> \brief freeze current split factor such that it is never changed during multiplication
709 : !> \param info ...
710 : !> \author Patrick Seewald
711 : ! **************************************************************************************************
712 0 : SUBROUTINE dbt_tas_set_strict_split(info)
713 : TYPE(dbt_tas_split_info), INTENT(INOUT) :: info
714 :
715 0 : info%strict_split = [.TRUE., .TRUE.]
716 0 : END SUBROUTINE
717 :
718 : END MODULE
|
