dbcsr_distribution_get Subroutine

public subroutine dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, subgroups_defined, prow_group, pcol_group)

Arguments

Type IntentOptional Attributes Name
type(dbcsr_distribution_type), intent(in) :: dist
integer, optional, DIMENSION(:), POINTER :: row_dist
integer, optional, DIMENSION(:), POINTER :: col_dist
integer, intent(out), optional :: nrows
integer, intent(out), optional :: ncols
logical, intent(out), optional :: has_threads
integer, intent(out), optional :: group
integer, intent(out), optional :: mynode
integer, intent(out), optional :: numnodes
integer, intent(out), optional :: nprows
integer, intent(out), optional :: npcols
integer, intent(out), optional :: myprow
integer, intent(out), optional :: mypcol
integer, optional, DIMENSION(:, :), POINTER :: pgrid
logical, intent(out), optional :: subgroups_defined
integer, intent(out), optional :: prow_group
integer, intent(out), optional :: pcol_group

Source Code

   SUBROUTINE dbcsr_distribution_get(dist, row_dist, col_dist, &
                                     nrows, ncols, has_threads, &
                                     group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, &
                                     subgroups_defined, prow_group, pcol_group)
      TYPE(dbcsr_distribution_type), INTENT(IN)          :: dist
      INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: row_dist, col_dist
      INTEGER, INTENT(OUT), OPTIONAL                     :: nrows, ncols
      LOGICAL, INTENT(OUT), OPTIONAL                     :: has_threads
      INTEGER, INTENT(OUT), OPTIONAL                     :: group, mynode, numnodes, nprows, npcols, &
                                                            myprow, mypcol
      INTEGER, DIMENSION(:, :), OPTIONAL, POINTER        :: pgrid
      LOGICAL, INTENT(OUT), OPTIONAL                     :: subgroups_defined
      INTEGER, INTENT(OUT), OPTIONAL                     :: prow_group, pcol_group

      TYPE(mp_comm_type) :: my_group, my_prow_group, my_pcol_group

      call dbcsr_distribution_get_prv(dist%prv, row_dist, col_dist, &
                                      nrows, ncols, has_threads, &
                                      my_group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, &
                                      subgroups_defined, my_prow_group, my_pcol_group)

      IF (PRESENT(group)) group = my_group%get_handle()
      IF (PRESENT(prow_group)) prow_group = my_prow_group%get_handle()
      IF (PRESENT(pcol_group)) pcol_group = my_pcol_group%get_handle()
   END SUBROUTINE dbcsr_distribution_get