LCOV - code coverage report
Current view: top level - src/dbt/tas - dbt_tas_split.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:0de0cc2) Lines: 212 233 91.0 %
Date: 2024-03-28 07:31:50 Functions: 15 17 88.2 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief 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     2481564 :    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      413594 :       CALL timeset(routineN, handle)
      88             : 
      89      413594 :       IF (PRESENT(own_comm)) THEN
      90      104681 :          own_comm_prv = own_comm
      91             :       ELSE
      92             :          own_comm_prv = .FALSE.
      93             :       END IF
      94             : 
      95      104681 :       IF (own_comm_prv) THEN
      96      104681 :          split_info%mp_comm = mp_comm
      97             :       ELSE
      98      308913 :          CALL split_info%mp_comm%from_dup(mp_comm)
      99             :       END IF
     100             : 
     101      413594 :       split_info%igroup = igroup
     102      413594 :       split_info%split_rowcol = split_rowcol
     103             : 
     104      413594 :       CALL mp_comm_group%from_split(mp_comm, igroup)
     105             : 
     106      413594 :       iproc = mp_comm%mepos
     107     1240782 :       pdims = mp_comm%num_pe_cart
     108     1240782 :       split_info%pdims = pdims
     109             : 
     110      413594 :       numproc_group = mp_comm_group%num_pe
     111      413594 :       iproc_group = mp_comm_group%mepos
     112             : 
     113      413594 :       IF (iproc == 0) THEN
     114      248791 :          to_assert = MOD(numproc_group, pdims(MOD(split_rowcol, 2) + 1)) == 0
     115      248791 :          CPASSERT(to_assert)
     116      248791 :          split_info%pgrid_split_size = numproc_group/pdims(MOD(split_rowcol, 2) + 1)
     117             :       END IF
     118      413594 :       CALL split_info%mp_comm%bcast(split_info%pgrid_split_size, 0)
     119             : 
     120      413594 :       ngroup = (pdims(split_rowcol) + split_info%pgrid_split_size - 1)/split_info%pgrid_split_size
     121      413594 :       split_info%ngroup = ngroup
     122      413594 :       split_info%group_size = split_info%pgrid_split_size*pdims(MOD(split_rowcol, 2) + 1)
     123             : 
     124      413594 :       CALL world_to_group_proc_map(iproc, pdims, split_rowcol, split_info%pgrid_split_size, igroup_check, pdims_group, iproc_group)
     125             : 
     126      413594 :       IF (igroup_check .NE. split_info%igroup) THEN
     127           0 :          CPABORT('inconsistent subgroups')
     128             :       END IF
     129             : 
     130      413594 :       CALL split_info%mp_comm_group%create(mp_comm_group, 2, pdims_group)
     131             : 
     132      413594 :       iproc_group_check = split_info%mp_comm_group%mepos
     133             : 
     134      413594 :       CPASSERT(iproc_group_check .EQ. iproc_group)
     135             : 
     136      413594 :       CALL mp_comm_group%free()
     137             : 
     138      413594 :       ALLOCATE (split_info%refcount)
     139      413594 :       split_info%refcount = 1
     140             : 
     141      413594 :       CALL timestop(handle)
     142             : 
     143      413594 :    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      104939 :    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      104939 :       CALL timeset(routineN, handle)
     165             : 
     166      104939 :       numproc = mp_comm%num_pe
     167             : 
     168      104939 :       npdims = dbt_tas_mp_dims(numproc, split_rowcol, nsplit)
     169             : 
     170      104939 :       CALL dbt_tas_mp_comm%create(mp_comm, 2, npdims)
     171             : 
     172      104939 :       CALL timestop(handle)
     173      104939 :    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      104939 :    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      104939 :       nsplit_opt = get_opt_nsplit(numproc, nsplit, split_pgrid=.FALSE.)
     191             : 
     192      104939 :       group_size = numproc/nsplit_opt
     193      104939 :       group_dims(:) = 0
     194             : 
     195      104939 :       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      104939 :       SELECT CASE (split_rowcol)
     200             :       CASE (rowsplit)
     201      473277 :          group_dims = [MINVAL(group_dims), MAXVAL(group_dims)]
     202             :       CASE (colsplit)
     203      366235 :          group_dims = [MAXVAL(group_dims), MINVAL(group_dims)]
     204             :       END SELECT
     205             : 
     206       67611 :       SELECT CASE (split_rowcol)
     207             :       CASE (rowsplit)
     208      202833 :          dbt_tas_mp_dims(:) = [group_dims(1)*nsplit_opt, group_dims(2)]
     209             :       CASE (colsplit)
     210      179595 :          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      273825 :    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      273825 :       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: nsplit_list, nsplit_list_accept, &
     234      273825 :                                                             nsplit_list_square
     235             :       INTEGER, DIMENSION(2)                              :: dims_sub
     236             : 
     237      273825 :       CPASSERT(nsplit > 0)
     238             : 
     239      273825 :       IF (split_pgrid) THEN
     240      168886 :          CPASSERT(PRESENT(pdim_nonsplit))
     241             :       END IF
     242             : 
     243      273825 :       lb = CEILING(REAL(nsplit, dp)/default_nsplit_accept_ratio)
     244      273825 :       ub = FLOOR(REAL(nsplit, dp)*default_nsplit_accept_ratio)
     245             : 
     246             :       IF (ub < lb) ub = lb
     247             : 
     248     1916775 :       ALLOCATE (nsplit_list(1:ub - lb + 1), nsplit_list_square(1:ub - lb + 1), nsplit_list_accept(1:ub - lb + 1))
     249     2664820 :       count = 0
     250     2664820 :       count_square = 0
     251     2664820 :       count_accept = 0
     252     2664820 :       DO split = lb, ub
     253     2664820 :          IF (MOD(numproc, split) == 0) THEN
     254      476579 :             count = count + 1
     255      476579 :             nsplit_list(count) = split
     256             : 
     257      476579 :             dims_sub = 0
     258      476579 :             IF (.NOT. split_pgrid) THEN
     259      190739 :                CALL mp_dims_create(numproc/split, dims_sub)
     260             :             ELSE
     261      857520 :                dims_sub = [numproc/split, pdim_nonsplit]
     262             :             END IF
     263             : 
     264      476579 :             IF (dims_sub(1) == dims_sub(2)) THEN
     265      264149 :                count_square = count_square + 1
     266      264149 :                nsplit_list_square(count_square) = split
     267      264149 :                count_accept = count_accept + 1
     268      264149 :                nsplit_list_accept(count_accept) = split
     269      212430 :             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      273825 :       IF (count_square > 0) THEN
     278      792447 :          minpos = MINLOC(ABS(nsplit_list_square(1:count_square) - nsplit), DIM=1)
     279      264149 :          get_opt_nsplit = nsplit_list_square(minpos)
     280        9676 :       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        9676 :       ELSEIF (count > 0) THEN
     284       17166 :          minpos = MINLOC(ABS(nsplit_list(1:count) - nsplit), DIM=1)
     285        5722 :          get_opt_nsplit = nsplit_list(minpos)
     286             :       ELSE
     287             :          get_opt_nsplit = nsplit
     288      403962 :          DO WHILE (MOD(numproc, get_opt_nsplit) .NE. 0)
     289      400008 :             get_opt_nsplit = get_opt_nsplit - 1
     290             :          END DO
     291             :       END IF
     292             : 
     293      273825 :    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         210 :    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         210 :       IF (nblkrows >= nblkcols) THEN
     312         204 :          split_rowcol = rowsplit
     313         204 :          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         210 :       mp_comm_new = dbt_tas_mp_comm(mp_comm, split_rowcol, nsplit)
     320         210 :    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     2481564 :    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      413594 :       CALL timeset(routineN, handle)
     346             : 
     347      413594 :       IF (PRESENT(opt_nsplit)) THEN
     348      308865 :          opt_nsplit_prv = opt_nsplit
     349             :       ELSE
     350             :          opt_nsplit_prv = .TRUE.
     351             :       END IF
     352             : 
     353      413594 :       CPASSERT(nsplit > 0)
     354             : 
     355      413594 :       iproc = mp_comm%mepos
     356     1240782 :       pdims = mp_comm%num_pe_cart
     357     1240782 :       pcoord = mp_comm%mepos_cart
     358             : 
     359      726262 :       SELECT CASE (split_rowcol)
     360             :       CASE (rowsplit)
     361      312668 :          pdim_split = pdims(1)
     362      312668 :          pdim_nonsplit = pdims(2)
     363             :       CASE (colsplit)
     364      100926 :          pdim_split = pdims(2)
     365      413594 :          pdim_nonsplit = pdims(1)
     366             :       END SELECT
     367             : 
     368      413594 :       IF (opt_nsplit_prv) THEN
     369      168886 :          nsplit_opt = get_opt_nsplit(pdim_split, nsplit, split_pgrid=.TRUE., pdim_nonsplit=pdim_nonsplit)
     370             :       ELSE
     371      244708 :          IF (MOD(pdims(split_rowcol), nsplit) .NE. 0) THEN
     372           0 :             CPABORT("Split factor does not divide process grid dimension")
     373             :          END IF
     374      244708 :          nsplit_opt = nsplit
     375             :       END IF
     376             : 
     377      413594 :       pdims_group = pdims
     378      413594 :       pdims_group(split_rowcol) = pdims_group(split_rowcol)/nsplit_opt
     379             : 
     380      413594 :       igroup = pcoord(split_rowcol)/pdims_group(split_rowcol)
     381             : 
     382      413594 :       CALL dbt_tas_create_split_rows_or_cols(split_info, mp_comm, nsplit_opt, igroup, split_rowcol, own_comm=own_comm)
     383             : 
     384      413594 :       IF (nsplit > 0) THEN
     385      413594 :          ALLOCATE (split_info%ngroup_opt, SOURCE=nsplit)
     386             :       END IF
     387             : 
     388      413594 :       CALL timestop(handle)
     389             : 
     390      413594 :    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      337977 :    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      337977 :       IF (relative) THEN
     407      125547 :          dims_opt = 0
     408      376641 :          CALL mp_dims_create(PRODUCT(dims), dims_opt)
     409      753282 :          accept_pgrid_dims = (MAXVAL(REAL(dims, dp))/MAXVAL(dims_opt) .LT. default_pdims_accept_ratio)
     410             :       ELSE
     411     1274580 :          accept_pgrid_dims = (MAXVAL(REAL(dims, dp))/MINVAL(dims) .LT. default_pdims_accept_ratio**2)
     412             :       END IF
     413      337977 :    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     2615115 :    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     1586323 :       IF (PRESENT(mp_comm)) mp_comm = info%mp_comm
     435     1586323 :       IF (PRESENT(mp_comm_group)) mp_comm_group = info%mp_comm_group
     436     1586323 :       IF (PRESENT(split_rowcol)) split_rowcol = info%split_rowcol
     437     1586323 :       IF (PRESENT(igroup)) igroup = info%igroup
     438     1586323 :       IF (PRESENT(nsplit)) nsplit = info%ngroup
     439             : 
     440     1586323 :       IF (PRESENT(pgrid_offset)) THEN
     441       82132 :          SELECT CASE (info%split_rowcol)
     442             :          CASE (rowsplit)
     443      107994 :             pgrid_offset(:) = [info%igroup*info%pgrid_split_size, 0]
     444             :          CASE (colsplit)
     445       66406 :             pgrid_offset(:) = [0, info%igroup*info%pgrid_split_size]
     446             :          END SELECT
     447             :       END IF
     448             : 
     449     1586323 :    END SUBROUTINE
     450             : 
     451             : ! **************************************************************************************************
     452             : !> \brief ...
     453             : !> \param split_info ...
     454             : !> \author Patrick Seewald
     455             : ! **************************************************************************************************
     456     2109127 :    SUBROUTINE dbt_tas_release_info(split_info)
     457             :       TYPE(dbt_tas_split_info), INTENT(INOUT)            :: split_info
     458             : 
     459             :       LOGICAL                                            :: abort
     460             : 
     461     2109127 :       abort = .FALSE.
     462             : 
     463     2109127 :       IF (.NOT. ASSOCIATED(split_info%refcount)) THEN
     464             :          abort = .TRUE.
     465     2109127 :       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     2109127 :       split_info%refcount = split_info%refcount - 1
     474             : 
     475     2109127 :       IF (split_info%refcount == 0) THEN
     476      413594 :          CALL split_info%mp_comm_group%free()
     477      413594 :          CALL split_info%mp_comm%free()
     478      413594 :          DEALLOCATE (split_info%refcount)
     479             :       END IF
     480             : 
     481     6327381 :       split_info%pdims = 0
     482             : 
     483     2109127 :       IF (ALLOCATED(split_info%ngroup_opt)) DEALLOCATE (split_info%ngroup_opt)
     484     2109127 :    END SUBROUTINE
     485             : 
     486             : ! **************************************************************************************************
     487             : !> \brief ...
     488             : !> \param split_info ...
     489             : !> \author Patrick Seewald
     490             : ! **************************************************************************************************
     491     1695533 :    SUBROUTINE dbt_tas_info_hold(split_info)
     492             :       TYPE(dbt_tas_split_info), INTENT(IN)               :: split_info
     493             : 
     494             :       INTEGER, POINTER                                   :: ref
     495             : 
     496     1695533 :       IF (split_info%refcount < 1) THEN
     497           0 :          CPABORT("can not hold non-existing split_info")
     498             :       END IF
     499     1695533 :       ref => split_info%refcount
     500     1695533 :       ref = ref + 1
     501     1695533 :    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      413594 :    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      413594 :       IF (PRESENT(iproc_group)) THEN
     526      413594 :          CPASSERT(PRESENT(pdims_group))
     527             :       END IF
     528             : 
     529     1240782 :       pcoord = [iproc/pdims(2), MOD(iproc, pdims(2))]
     530             : 
     531      413594 :       igroup = pcoord(split_rowcol)/pgrid_split_size
     532             : 
     533      312668 :       SELECT CASE (split_rowcol)
     534             :       CASE (rowsplit)
     535      938004 :          IF (PRESENT(pdims_group)) pdims_group = [pgrid_split_size, pdims(2)]
     536      938004 :          IF (PRESENT(iproc_group)) pcoord_group = [MOD(pcoord(1), pgrid_split_size), pcoord(2)]
     537             :       CASE (colsplit)
     538      302778 :          IF (PRESENT(pdims_group)) pdims_group = [pdims(1), pgrid_split_size]
     539      716372 :          IF (PRESENT(iproc_group)) pcoord_group = [pcoord(1), MOD(pcoord(2), pgrid_split_size)]
     540             :       END SELECT
     541      413594 :       IF (PRESENT(iproc_group)) iproc_group = pcoord_group(1)*pdims_group(2) + pcoord_group(2)
     542      413594 :    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    89418284 :    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   118132072 :       SELECT CASE (info%split_rowcol)
     598             :       CASE (rowsplit)
     599    28713788 :          ASSOCIATE (rows => dist%local_rowcols)
     600    28713788 :             IF (PRESENT(row)) row = rows(row_group)
     601    57427576 :             IF (PRESENT(column)) column = column_group
     602             :          END ASSOCIATE
     603             :       CASE (colsplit)
     604    89418284 :          ASSOCIATE (cols => dist%local_rowcols)
     605    22377462 :             IF (PRESENT(row)) row = row_group
     606    83081958 :             IF (PRESENT(column)) column = cols(column_group)
     607             :          END ASSOCIATE
     608             :       END SELECT
     609    89418284 :    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    63203789 :    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    93174367 :       SELECT CASE (info%split_rowcol)
     628             :       CASE (rowsplit)
     629    29970578 :          IF (PRESENT(row_group)) row_group = i8_bsearch(dist%local_rowcols, row)
     630    29970578 :          IF (PRESENT(column_group)) column_group = INT(column)
     631             :       CASE (colsplit)
     632    33233211 :          IF (PRESENT(row_group)) row_group = INT(row)
     633    96437000 :          IF (PRESENT(column_group)) column_group = i8_bsearch(dist%local_rowcols, column)
     634             :       END SELECT
     635             : 
     636    63203789 :    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    63203789 :    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    63203789 :       lindex = 1
     655    63203789 :       uindex = SIZE(array)
     656    63203789 :       IF (PRESENT(l_index)) lindex = l_index
     657    63203789 :       IF (PRESENT(u_index)) uindex = u_index
     658   457341854 :       DO WHILE (lindex <= uindex)
     659   394138065 :          aindex = (lindex + uindex)/2
     660   457341854 :          IF (array(aindex) < el) THEN
     661   173371676 :             lindex = aindex + 1
     662             :          ELSE
     663   220766389 :             uindex = aindex - 1
     664             :          END IF
     665             :       END DO
     666    63203789 :       res = lindex
     667    63203789 :    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      589162 :    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     1178324 :       INTEGER, DIMENSION(0:info%pgrid_split_size - 1)             :: nrowcols_group
     684             :       INTEGER                                                     :: pcoord, nrowcols, count, pcoord_group
     685      589162 :       INTEGER, DIMENSION(:), ALLOCATABLE                          :: sort_indices
     686             : 
     687     1242270 :       nrowcols_group(:) = 0
     688     1242270 :       DO pcoord = igroup*info%pgrid_split_size, (igroup + 1)*info%pgrid_split_size - 1
     689      653108 :          pcoord_group = pcoord - igroup*info%pgrid_split_size
     690     1242270 :          nrowcols_group(pcoord_group) = SIZE(rowcol_dist%rowcols(pcoord))
     691             :       END DO
     692     1242270 :       nrowcols = SUM(nrowcols_group)
     693             : 
     694     1765403 :       ALLOCATE (rowcols(nrowcols))
     695             : 
     696      589162 :       count = 0
     697     1242270 :       DO pcoord = igroup*info%pgrid_split_size, (igroup + 1)*info%pgrid_split_size - 1
     698      653108 :          pcoord_group = pcoord - igroup*info%pgrid_split_size
     699    13098304 :          rowcols(count + 1:count + nrowcols_group(pcoord_group)) = rowcol_dist%rowcols(pcoord)
     700     1242270 :          count = count + nrowcols_group(pcoord_group)
     701             :       END DO
     702             : 
     703     1765403 :       ALLOCATE (sort_indices(nrowcols))
     704      589162 :       CALL sort(rowcols, nrowcols, sort_indices)
     705      589162 :    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

Generated by: LCOV version 1.15