dbcsr_mp_make_env Subroutine

   SUBROUTINE dbcsr_mp_make_env(mp_env, cart_group, mp_group, &
                                nprocs, pgrid_dims)
      !! Creates a sane mp_obj from the given MPI comm that is not a cartesian one (hack)

      TYPE(dbcsr_mp_obj), INTENT(OUT)                    :: mp_env
         !! Message-passing environment object to create
      TYPE(mp_comm_type), INTENT(OUT)                               :: cart_group
         !! the created cartesian group (to be freed by the user)
      TYPE(mp_comm_type), INTENT(IN)                                :: mp_group
         !! MPI group
      INTEGER, INTENT(IN), OPTIONAL                      :: nprocs
         !! Number of processes
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: pgrid_dims
         !! Dimensions of MPI group

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

      INTEGER                                            :: error_handle, mynode, numnodes, pcol, &
                                                            prow
      INTEGER, ALLOCATABLE, DIMENSION(:, :)              :: pgrid
      INTEGER, DIMENSION(2)                              :: coord, myploc, npdims
      LOGICAL                                            :: alive

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

      CALL timeset(routineN, error_handle)
      CALL mp_environ(numnodes, mynode, mp_group)
      IF (PRESENT(nprocs)) THEN
         IF (nprocs > numnodes) &
            DBCSR_ABORT("Can not grow processes.")
         numnodes = nprocs
      END IF
      !
      IF (PRESENT(pgrid_dims)) THEN
         npdims(:) = pgrid_dims
      ELSE
         npdims(:) = 0
         CALL mp_dims_create(numnodes, npdims)
      END IF
      CALL mp_cart_create(mp_group, 2, npdims, myploc, cart_group)
      alive = cart_group .NE. mp_comm_null
      IF (alive) THEN
         CALL mp_environ(numnodes, mynode, cart_group)
         ALLOCATE (pgrid(0:npdims(1) - 1, 0:npdims(2) - 1))
         DO prow = 0, npdims(1) - 1
            DO pcol = 0, npdims(2) - 1
               coord = (/prow, pcol/)
               CALL mp_cart_rank(cart_group, coord, pgrid(prow, pcol))
            END DO
         END DO
         CALL dbcsr_mp_new(mp_env, cart_group, pgrid, &
                           mynode, numnodes, &
                           myprow=myploc(1), mypcol=myploc(2))
      ELSE
         CALL dbcsr_mp_init(mp_env)
      END IF
      CALL timestop(error_handle)
   END SUBROUTINE dbcsr_mp_make_env