dbcsr_distribution_new_low Subroutine

private subroutine dbcsr_distribution_new_low(dist, mp_env, row_dist_block, col_dist_block, local_rows, local_cols, reuse_arrays)

Creates new distribution

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_distribution_obj), intent(out) :: dist

distribution

type(dbcsr_mp_obj), intent(in) :: mp_env

multiprocessing environment

integer, intent(in), DIMENSION(:), POINTER, CONTIGUOUS:: row_dist_block
integer, intent(in), DIMENSION(:), POINTER, CONTIGUOUS:: col_dist_block
integer, intent(in), optional DIMENSION(:), POINTER, CONTIGUOUS:: local_rows
integer, intent(in), optional DIMENSION(:), POINTER, CONTIGUOUS:: local_cols
logical, optional :: reuse_arrays

Contents


Source Code

   SUBROUTINE dbcsr_distribution_new_low(dist, mp_env, row_dist_block, col_dist_block, &
                                         local_rows, local_cols, &
                                         reuse_arrays)
      !! Creates new distribution

      TYPE(dbcsr_distribution_obj), INTENT(OUT)          :: dist
         !! distribution
      TYPE(dbcsr_mp_obj), INTENT(IN)                     :: mp_env
         !! multiprocessing environment
      INTEGER, DIMENSION(:), INTENT(IN), POINTER, CONTIGUOUS :: row_dist_block, col_dist_block
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL, &
         POINTER, CONTIGUOUS                             :: local_rows, local_cols
      LOGICAL, OPTIONAL                                  :: reuse_arrays

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_distribution_new'

      INTEGER                                            :: handle, i, lcmv, mypcoor, npcols, &
                                                            nprows, seq
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: col_dist_tmp, row_dist_tmp

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)

      nprows = dbcsr_mp_nprows(mp_env)
      npcols = dbcsr_mp_npcols(mp_env)
      lcmv = lcm(nprows, npcols)

      ALLOCATE (dist%d)
      dist%d%refcount = 1
      row_dist_tmp => row_dist_block
      col_dist_tmp => col_dist_block
      CALL array_new(dist%d%row_dist_block, row_dist_tmp, gift=reuse_arrays)
      CALL array_new(dist%d%col_dist_block, col_dist_tmp, gift=reuse_arrays)

      dist%d%mp_env = mp_env
      CALL dbcsr_mp_hold(dist%d%mp_env)
      ! Verify given process row distribution.
      dist%d%max_row_dist = MAXVAL(row_dist_block)
      IF (dist%d%max_row_dist .GE. nprows) &
         DBCSR_ABORT("A process row is too big for process grid")
      ! Verify given process column distribution.
      dist%d%max_col_dist = MAXVAL(col_dist_block)
      IF (dist%d%max_col_dist .GE. npcols) &
         DBCSR_ABORT("A process column is too big for process grid")
      IF (PRESENT(local_rows)) THEN
         CALL array_new(dist%d%local_rows, local_rows, gift=reuse_arrays)
      ELSE
         mypcoor = dbcsr_mp_myprow(mp_env)
         i = COUNT(row_dist_block .EQ. mypcoor)
         ALLOCATE (row_dist_tmp(i))
         seq = 1
         DO i = 1, SIZE(row_dist_block)
            IF (row_dist_block(i) .EQ. mypcoor) THEN
               row_dist_tmp(seq) = i
               seq = seq + 1
            END IF
         END DO
         CALL array_new(dist%d%local_rows, row_dist_tmp, gift=.TRUE.)
      END IF
      IF (PRESENT(local_cols)) THEN
         CALL array_new(dist%d%local_cols, local_cols, gift=reuse_arrays)
      ELSE
         mypcoor = dbcsr_mp_mypcol(mp_env)
         i = COUNT(col_dist_block .EQ. mypcoor)
         ALLOCATE (col_dist_tmp(i))
         seq = 1
         DO i = 1, SIZE(col_dist_block)
            IF (col_dist_block(i) .EQ. mypcoor) THEN
               col_dist_tmp(seq) = i
               seq = seq + 1
            END IF
         END DO
         CALL array_new(dist%d%local_cols, col_dist_tmp, gift=.TRUE.)
      END IF

      dist%d%num_threads = 1
!$    dist%d%num_threads = OMP_GET_MAX_THREADS()
      dist%d%has_thread_dist = .FALSE.
      CALL array_nullify(dist%d%thread_dist)
      CALL array_nullify(dist%d%row_map)
      CALL array_nullify(dist%d%col_map)
      NULLIFY (dist%d%other_l_rows)
      NULLIFY (dist%d%other_l_cols)
      dist%d%has_other_l_rows = .FALSE.
      dist%d%has_other_l_cols = .FALSE.
      CALL array_nullify(dist%d%global_row_map)
      CALL array_nullify(dist%d%global_col_map)
      dist%d%has_global_row_map = .FALSE.
      dist%d%has_global_col_map = .FALSE.

      CALL timestop(handle)

   END SUBROUTINE dbcsr_distribution_new_low