Loading [MathJax]/extensions/tex2jax.js
 (git:aabdcc8)
•All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
dbt_tas_split.F
Go to the documentation of this file.
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! **************************************************************************************************
13MODULE 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
59CONTAINS
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 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 CALL timeset(routinen, handle)
88
89 IF (PRESENT(own_comm)) THEN
90 own_comm_prv = own_comm
91 ELSE
92 own_comm_prv = .false.
93 END IF
94
95 IF (own_comm_prv) THEN
96 split_info%mp_comm = mp_comm
97 ELSE
98 CALL split_info%mp_comm%from_dup(mp_comm)
99 END IF
100
101 split_info%igroup = igroup
102 split_info%split_rowcol = split_rowcol
103
104 CALL mp_comm_group%from_split(mp_comm, igroup)
105
106 iproc = mp_comm%mepos
107 pdims = mp_comm%num_pe_cart
108 split_info%pdims = pdims
109
110 numproc_group = mp_comm_group%num_pe
111 iproc_group = mp_comm_group%mepos
112
113 IF (iproc == 0) THEN
114 to_assert = mod(numproc_group, pdims(mod(split_rowcol, 2) + 1)) == 0
115 cpassert(to_assert)
116 split_info%pgrid_split_size = numproc_group/pdims(mod(split_rowcol, 2) + 1)
117 END IF
118 CALL split_info%mp_comm%bcast(split_info%pgrid_split_size, 0)
119
120 ngroup = (pdims(split_rowcol) + split_info%pgrid_split_size - 1)/split_info%pgrid_split_size
121 split_info%ngroup = ngroup
122 split_info%group_size = split_info%pgrid_split_size*pdims(mod(split_rowcol, 2) + 1)
123
124 CALL world_to_group_proc_map(iproc, pdims, split_rowcol, split_info%pgrid_split_size, igroup_check, pdims_group, iproc_group)
125
126 IF (igroup_check .NE. split_info%igroup) THEN
127 cpabort('inconsistent subgroups')
128 END IF
129
130 CALL split_info%mp_comm_group%create(mp_comm_group, 2, pdims_group)
131
132 iproc_group_check = split_info%mp_comm_group%mepos
133
134 cpassert(iproc_group_check .EQ. iproc_group)
135
136 CALL mp_comm_group%free()
137
138 ALLOCATE (split_info%refcount)
139 split_info%refcount = 1
140
141 CALL timestop(handle)
142
143 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 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 CALL timeset(routinen, handle)
165
166 numproc = mp_comm%num_pe
167
168 npdims = dbt_tas_mp_dims(numproc, split_rowcol, nsplit)
169
170 CALL dbt_tas_mp_comm%create(mp_comm, 2, npdims)
171
172 CALL timestop(handle)
173 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 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 nsplit_opt = get_opt_nsplit(numproc, nsplit, split_pgrid=.false.)
191
192 group_size = numproc/nsplit_opt
193 group_dims(:) = 0
194
195 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 SELECT CASE (split_rowcol)
200 CASE (rowsplit)
201 group_dims = [minval(group_dims), maxval(group_dims)]
202 CASE (colsplit)
203 group_dims = [maxval(group_dims), minval(group_dims)]
204 END SELECT
205
206 SELECT CASE (split_rowcol)
207 CASE (rowsplit)
208 dbt_tas_mp_dims(:) = [group_dims(1)*nsplit_opt, group_dims(2)]
209 CASE (colsplit)
210 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 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 INTEGER, ALLOCATABLE, DIMENSION(:) :: nsplit_list, nsplit_list_accept, &
234 nsplit_list_square
235 INTEGER, DIMENSION(2) :: dims_sub
236
237 cpassert(nsplit > 0)
238
239 IF (split_pgrid) THEN
240 cpassert(PRESENT(pdim_nonsplit))
241 END IF
242
243 lb = ceiling(real(nsplit, dp)/default_nsplit_accept_ratio)
244 ub = floor(real(nsplit, dp)*default_nsplit_accept_ratio)
245
246 IF (ub < lb) ub = lb
247
248 ALLOCATE (nsplit_list(1:ub - lb + 1), nsplit_list_square(1:ub - lb + 1), nsplit_list_accept(1:ub - lb + 1))
249 count = 0
250 count_square = 0
251 count_accept = 0
252 DO split = lb, ub
253 IF (mod(numproc, split) == 0) THEN
254 count = count + 1
255 nsplit_list(count) = split
256
257 dims_sub = 0
258 IF (.NOT. split_pgrid) THEN
259 CALL mp_dims_create(numproc/split, dims_sub)
260 ELSE
261 dims_sub = [numproc/split, pdim_nonsplit]
262 END IF
263
264 IF (dims_sub(1) == dims_sub(2)) THEN
265 count_square = count_square + 1
266 nsplit_list_square(count_square) = split
267 count_accept = count_accept + 1
268 nsplit_list_accept(count_accept) = split
269 ELSEIF (accept_pgrid_dims(dims_sub, relative=.false.)) THEN
270 count_accept = count_accept + 1
271 nsplit_list_accept(count_accept) = split
272 END IF
273
274 END IF
275 END DO
276
277 IF (count_square > 0) THEN
278 minpos = minloc(abs(nsplit_list_square(1:count_square) - nsplit), dim=1)
279 get_opt_nsplit = nsplit_list_square(minpos)
280 ELSEIF (count_accept > 0) THEN
281 minpos = minloc(abs(nsplit_list_accept(1:count_accept) - nsplit), dim=1)
282 get_opt_nsplit = nsplit_list_accept(minpos)
283 ELSEIF (count > 0) THEN
284 minpos = minloc(abs(nsplit_list(1:count) - nsplit), dim=1)
285 get_opt_nsplit = nsplit_list(minpos)
286 ELSE
287 get_opt_nsplit = nsplit
288 DO WHILE (mod(numproc, get_opt_nsplit) .NE. 0)
289 get_opt_nsplit = get_opt_nsplit - 1
290 END DO
291 END IF
292
293 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 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 IF (nblkrows >= nblkcols) THEN
312 split_rowcol = rowsplit
313 nsplit = int((nblkrows - 1)/nblkcols + 1)
314 ELSE
315 split_rowcol = colsplit
316 nsplit = int((nblkcols - 1)/nblkrows + 1)
317 END IF
318
319 mp_comm_new = dbt_tas_mp_comm(mp_comm, split_rowcol, nsplit)
320 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 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 CALL timeset(routinen, handle)
346
347 IF (PRESENT(opt_nsplit)) THEN
348 opt_nsplit_prv = opt_nsplit
349 ELSE
350 opt_nsplit_prv = .true.
351 END IF
352
353 cpassert(nsplit > 0)
354
355 iproc = mp_comm%mepos
356 pdims = mp_comm%num_pe_cart
357 pcoord = mp_comm%mepos_cart
358
359 SELECT CASE (split_rowcol)
360 CASE (rowsplit)
361 pdim_split = pdims(1)
362 pdim_nonsplit = pdims(2)
363 CASE (colsplit)
364 pdim_split = pdims(2)
365 pdim_nonsplit = pdims(1)
366 END SELECT
367
368 IF (opt_nsplit_prv) THEN
369 nsplit_opt = get_opt_nsplit(pdim_split, nsplit, split_pgrid=.true., pdim_nonsplit=pdim_nonsplit)
370 ELSE
371 IF (mod(pdims(split_rowcol), nsplit) .NE. 0) THEN
372 cpabort("Split factor does not divide process grid dimension")
373 END IF
374 nsplit_opt = nsplit
375 END IF
376
377 pdims_group = pdims
378 pdims_group(split_rowcol) = pdims_group(split_rowcol)/nsplit_opt
379
380 igroup = pcoord(split_rowcol)/pdims_group(split_rowcol)
381
382 CALL dbt_tas_create_split_rows_or_cols(split_info, mp_comm, nsplit_opt, igroup, split_rowcol, own_comm=own_comm)
383
384 IF (nsplit > 0) THEN
385 ALLOCATE (split_info%ngroup_opt, source=nsplit)
386 END IF
387
388 CALL timestop(handle)
389
390 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 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 IF (relative) THEN
407 dims_opt = 0
408 CALL mp_dims_create(product(dims), dims_opt)
409 accept_pgrid_dims = (maxval(real(dims, dp))/maxval(dims_opt) .LT. default_pdims_accept_ratio)
410 ELSE
411 accept_pgrid_dims = (maxval(real(dims, dp))/minval(dims) .LT. default_pdims_accept_ratio**2)
412 END IF
413 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 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 IF (PRESENT(mp_comm)) mp_comm = info%mp_comm
435 IF (PRESENT(mp_comm_group)) mp_comm_group = info%mp_comm_group
436 IF (PRESENT(split_rowcol)) split_rowcol = info%split_rowcol
437 IF (PRESENT(igroup)) igroup = info%igroup
438 IF (PRESENT(nsplit)) nsplit = info%ngroup
439
440 IF (PRESENT(pgrid_offset)) THEN
441 SELECT CASE (info%split_rowcol)
442 CASE (rowsplit)
443 pgrid_offset(:) = [info%igroup*info%pgrid_split_size, 0]
444 CASE (colsplit)
445 pgrid_offset(:) = [0, info%igroup*info%pgrid_split_size]
446 END SELECT
447 END IF
448
449 END SUBROUTINE
450
451! **************************************************************************************************
452!> \brief ...
453!> \param split_info ...
454!> \author Patrick Seewald
455! **************************************************************************************************
456 SUBROUTINE dbt_tas_release_info(split_info)
457 TYPE(dbt_tas_split_info), INTENT(INOUT) :: split_info
458
459 LOGICAL :: abort
460
461 abort = .false.
462
463 IF (.NOT. ASSOCIATED(split_info%refcount)) THEN
464 abort = .true.
465 ELSEIF (split_info%refcount < 1) THEN
466 abort = .true.
467 END IF
468
469 IF (abort) THEN
470 cpabort("can not destroy non-existing split_info")
471 END IF
472
473 split_info%refcount = split_info%refcount - 1
474
475 IF (split_info%refcount == 0) THEN
476 CALL split_info%mp_comm_group%free()
477 CALL split_info%mp_comm%free()
478 DEALLOCATE (split_info%refcount)
479 END IF
480
481 split_info%pdims = 0
482
483 IF (ALLOCATED(split_info%ngroup_opt)) DEALLOCATE (split_info%ngroup_opt)
484 END SUBROUTINE
485
486! **************************************************************************************************
487!> \brief ...
488!> \param split_info ...
489!> \author Patrick Seewald
490! **************************************************************************************************
491 SUBROUTINE dbt_tas_info_hold(split_info)
492 TYPE(dbt_tas_split_info), INTENT(IN) :: split_info
493
494 INTEGER, POINTER :: ref
495
496 IF (split_info%refcount < 1) THEN
497 cpabort("can not hold non-existing split_info")
498 END IF
499 ref => split_info%refcount
500 ref = ref + 1
501 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 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 IF (PRESENT(iproc_group)) THEN
526 cpassert(PRESENT(pdims_group))
527 END IF
528
529 pcoord = [iproc/pdims(2), mod(iproc, pdims(2))]
530
531 igroup = pcoord(split_rowcol)/pgrid_split_size
532
533 SELECT CASE (split_rowcol)
534 CASE (rowsplit)
535 IF (PRESENT(pdims_group)) pdims_group = [pgrid_split_size, pdims(2)]
536 IF (PRESENT(iproc_group)) pcoord_group = [mod(pcoord(1), pgrid_split_size), pcoord(2)]
537 CASE (colsplit)
538 IF (PRESENT(pdims_group)) pdims_group = [pdims(1), pgrid_split_size]
539 IF (PRESENT(iproc_group)) pcoord_group = [pcoord(1), mod(pcoord(2), pgrid_split_size)]
540 END SELECT
541 IF (PRESENT(iproc_group)) iproc_group = pcoord_group(1)*pdims_group(2) + pcoord_group(2)
542 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 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 SELECT CASE (split_rowcol)
564 CASE (rowsplit)
565 pdims_group = [pgrid_split_size, pdims(2)]
566 CASE (colsplit)
567 pdims_group = [pdims(1), pgrid_split_size]
568 END SELECT
569
570 pcoord_group = [iproc_group/pdims_group(2), mod(iproc_group, pdims_group(2))]
571
572 SELECT CASE (split_rowcol)
573 CASE (rowsplit)
574 pcoord = [igroup*pgrid_split_size + pcoord_group(1), pcoord_group(2)]
575 CASE (colsplit)
576 pcoord = [pcoord_group(1), igroup*pgrid_split_size + pcoord_group(2)]
577 END SELECT
578 iproc = pcoord(1)*pdims(2) + pcoord(2)
579 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 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 SELECT CASE (info%split_rowcol)
598 CASE (rowsplit)
599 associate(rows => dist%local_rowcols)
600 IF (PRESENT(row)) row = rows(row_group)
601 IF (PRESENT(column)) column = column_group
602 END associate
603 CASE (colsplit)
604 associate(cols => dist%local_rowcols)
605 IF (PRESENT(row)) row = row_group
606 IF (PRESENT(column)) column = cols(column_group)
607 END associate
608 END SELECT
609 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 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 SELECT CASE (info%split_rowcol)
628 CASE (rowsplit)
629 IF (PRESENT(row_group)) row_group = i8_bsearch(dist%local_rowcols, row)
630 IF (PRESENT(column_group)) column_group = int(column)
631 CASE (colsplit)
632 IF (PRESENT(row_group)) row_group = int(row)
633 IF (PRESENT(column_group)) column_group = i8_bsearch(dist%local_rowcols, column)
634 END SELECT
635
636 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 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 lindex = 1
655 uindex = SIZE(array)
656 IF (PRESENT(l_index)) lindex = l_index
657 IF (PRESENT(u_index)) uindex = u_index
658 DO WHILE (lindex <= uindex)
659 aindex = (lindex + uindex)/2
660 IF (array(aindex) < el) THEN
661 lindex = aindex + 1
662 ELSE
663 uindex = aindex - 1
664 END IF
665 END DO
666 res = lindex
667 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 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 INTEGER, DIMENSION(0:info%pgrid_split_size - 1) :: nrowcols_group
684 INTEGER :: pcoord, nrowcols, count, pcoord_group
685 INTEGER, DIMENSION(:), ALLOCATABLE :: sort_indices
686
687 nrowcols_group(:) = 0
688 DO pcoord = igroup*info%pgrid_split_size, (igroup + 1)*info%pgrid_split_size - 1
689 pcoord_group = pcoord - igroup*info%pgrid_split_size
690 nrowcols_group(pcoord_group) = SIZE(rowcol_dist%rowcols(pcoord))
691 END DO
692 nrowcols = sum(nrowcols_group)
693
694 ALLOCATE (rowcols(nrowcols))
695
696 count = 0
697 DO pcoord = igroup*info%pgrid_split_size, (igroup + 1)*info%pgrid_split_size - 1
698 pcoord_group = pcoord - igroup*info%pgrid_split_size
699 rowcols(count + 1:count + nrowcols_group(pcoord_group)) = rowcol_dist%rowcols(pcoord)
700 count = count + nrowcols_group(pcoord_group)
701 END DO
702
703 ALLOCATE (sort_indices(nrowcols))
704 CALL sort(rowcols, nrowcols, sort_indices)
705 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 SUBROUTINE dbt_tas_set_strict_split(info)
713 TYPE(dbt_tas_split_info), INTENT(INOUT) :: info
714
715 info%strict_split = [.true., .true.]
716 END SUBROUTINE
717
718END MODULE
dbt_tas_split::dbt_tas_mp_comm
Definition dbt_tas_split.F:54
dbt_tas_global
Global data (distribution and block sizes) for tall-and-skinny matrices For very sparse matrices with...
Definition dbt_tas_global.F:17
dbt_tas_split
methods to split tall-and-skinny matrices along longest dimension. Basically, we are splitting proces...
Definition dbt_tas_split.F:13
dbt_tas_split::dbt_index_global_to_local
subroutine, public dbt_index_global_to_local(info, dist, row, column, row_group, column_group)
map global block index to group local index
Definition dbt_tas_split.F:622
dbt_tas_split::dbt_tas_mp_dims
integer function, dimension(2), public dbt_tas_mp_dims(numproc, split_rowcol, nsplit)
Get optimal process grid dimensions consistent with dbt_tas_create_split.
Definition dbt_tas_split.F:184
dbt_tas_split::group_to_mrowcol
subroutine, public group_to_mrowcol(info, rowcol_dist, igroup, rowcols)
maps a process subgroup to matrix rows/columns
Definition dbt_tas_split.F:678
dbt_tas_split::dbt_tas_release_info
subroutine, public dbt_tas_release_info(split_info)
...
Definition dbt_tas_split.F:457
dbt_tas_split::dbt_index_local_to_global
subroutine, public dbt_index_local_to_global(info, dist, row_group, column_group, row, column)
map group local block index to global matrix index
Definition dbt_tas_split.F:592
dbt_tas_split::rowsplit
integer, parameter, public rowsplit
Definition dbt_tas_split.F:50
dbt_tas_split::dbt_tas_get_split_info
subroutine, public dbt_tas_get_split_info(info, mp_comm, nsplit, igroup, mp_comm_group, split_rowcol, pgrid_offset)
Get info on split.
Definition dbt_tas_split.F:427
dbt_tas_split::colsplit
integer, parameter, public colsplit
Definition dbt_tas_split.F:50
dbt_tas_split::dbt_tas_create_split
subroutine, public dbt_tas_create_split(split_info, mp_comm, split_rowcol, nsplit, own_comm, opt_nsplit)
Split Cartesian process grid using a default split heuristic.
Definition dbt_tas_split.F:333
dbt_tas_split::dbt_tas_create_split_rows_or_cols
subroutine, public dbt_tas_create_split_rows_or_cols(split_info, mp_comm, ngroup, igroup, split_rowcol, own_comm)
split mpi grid by rows or columns
Definition dbt_tas_split.F:72
dbt_tas_split::default_nsplit_accept_ratio
real(dp), parameter, public default_nsplit_accept_ratio
Definition dbt_tas_split.F:52
dbt_tas_split::world_to_group_proc_map
subroutine, public world_to_group_proc_map(iproc, pdims, split_rowcol, pgrid_split_size, igroup, pdims_group, iproc_group)
map global process info to group
Definition dbt_tas_split.F:516
dbt_tas_split::default_pdims_accept_ratio
real(dp), parameter, public default_pdims_accept_ratio
Definition dbt_tas_split.F:51
dbt_tas_split::dbt_tas_info_hold
subroutine, public dbt_tas_info_hold(split_info)
...
Definition dbt_tas_split.F:492
dbt_tas_split::dbt_tas_set_strict_split
subroutine, public dbt_tas_set_strict_split(info)
freeze current split factor such that it is never changed during multiplication
Definition dbt_tas_split.F:713
dbt_tas_split::group_to_world_proc_map
subroutine, public group_to_world_proc_map(iproc, pdims, split_rowcol, pgrid_split_size, igroup, iproc_group)
map local process info to global info
Definition dbt_tas_split.F:556
dbt_tas_split::accept_pgrid_dims
logical function, public accept_pgrid_dims(dims, relative)
Whether to accept proposed process grid dimensions (based on ratio of dimensions)
Definition dbt_tas_split.F:400
dbt_tas_types
DBT tall-and-skinny base types. Mostly wrappers around existing DBM routines.
Definition dbt_tas_types.F:13
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition kinds.F:54
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
message_passing::mp_dims_create
subroutine, public mp_dims_create(nodes, dims)
wrapper to MPI_Dims_create
Definition message_passing.F:2132
util
All kind of helpful little routines.
Definition util.F:14
dbt_tas_global::dbt_tas_distribution
Definition dbt_tas_global.F:47
dbt_tas_types::dbt_tas_distribution_type
Definition dbt_tas_types.F:66
dbt_tas_types::dbt_tas_split_info
Definition dbt_tas_types.F:52
message_passing::mp_cart_type
Definition message_passing.F:740
message_passing::mp_comm_type
Definition message_passing.F:189