(git:e7e05ae)
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-2024 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  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 
718 END MODULE
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_mp_comm
type(mp_cart_type) function, public dbt_tas_mp_comm(mp_comm, split_rowcol, nsplit)
Create default cartesian process grid that is consistent with default split heuristic of dbt_tas_crea...
Definition: dbt_tas_split.F:155
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