Make communicators for 3D layers for C-reduction
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | my_num_layers_3D | |||
type(dbcsr_mp_obj), | intent(inout) | :: | mp_obj |
SUBROUTINE make_layers_3D_C_reduction(my_num_layers_3D, mp_obj)
!! Make communicators for 3D layers for C-reduction
INTEGER, INTENT(IN) :: my_num_layers_3D
TYPE(dbcsr_mp_obj), INTENT(INOUT) :: mp_obj
CHARACTER(len=100) :: msg
INTEGER :: color, key, mygrp, mypcol, myprow, &
npcols, nprows, numnodes
LOGICAL :: do_layers_3D
LOGICAL, SAVE :: warning = .TRUE.
CALL dbcsr_mp_grid_setup(mp_obj)
IF (my_num_layers_3D .LE. 1) THEN
! Reset 3D communicator if it was previously declared
IF (layers_3D_C_reduction%num_layers_3D .GT. 1) CALL release_layers_3D_C_reduction()
RETURN
END IF
!
! Check if any existing 3D communicator can be reused
mygrp = dbcsr_mp_group(mp_obj)
IF (layers_3D_C_reduction%grp .EQ. mygrp .AND. &
layers_3D_C_reduction%num_layers_3D .EQ. my_num_layers_3D) RETURN
!
! Reset 3D communicator
CALL release_layers_3D_C_reduction()
!
! Checks for 3D algorithm
numnodes = dbcsr_mp_numnodes(mp_obj)
nprows = dbcsr_mp_nprows(mp_obj)
npcols = dbcsr_mp_npcols(mp_obj)
IF (dbcsr_cfg%use_mpi_rma%val) THEN
IF (nprows .NE. npcols) THEN
! No square topology, scale the maximum coordinate
do_layers_3D = MAX(nprows, npcols) .EQ. (my_num_layers_3D*MIN(nprows, npcols)) .AND. &
my_num_layers_3D .LE. MIN(nprows, npcols)
ELSE
! Square topology, scale both coordinates
do_layers_3D = ((nprows/NINT(SQRT(REAL(MAX(1, my_num_layers_3D), KIND=real_8))))**2)* &
my_num_layers_3D .EQ. (nprows*npcols)
END IF
IF (.NOT. do_layers_3D .AND. warning) THEN
WRITE (UNIT=msg, FMT='(A,I3,A,I3,A,I3,A)') "Cannot make 3D layers with ", my_num_layers_3D, &
" layers and (", nprows, "x", npcols, ") ranks! Run with a single layer."
DBCSR_WARN(msg)
warning = .FALSE.
END IF
IF (do_layers_3D) THEN
layers_3D_C_reduction%grp = mygrp
layers_3D_C_reduction%num_layers_3D = my_num_layers_3D
layers_3D_C_reduction%max_num_layers_3D = &
MAX(layers_3D_C_reduction%max_num_layers_3D, &
my_num_layers_3D)
layers_3D_C_reduction%side3D = NINT(SQRT(REAL(numnodes/my_num_layers_3D, KIND=real_8)))
!
! Create a new 3D communicator
myprow = dbcsr_mp_myprow(mp_obj)
mypcol = dbcsr_mp_mypcol(mp_obj)
! Row-wise order for color
color = MOD(myprow, layers_3D_C_reduction%side3D)* &
layers_3D_C_reduction%side3D + MOD(mypcol, layers_3D_C_reduction%side3D)
! Column-major order
key = get_rank3D(myprow, mypcol, nprows, layers_3D_C_reduction%side3D)
CALL mp_comm_split_direct(mygrp, layers_3D_C_reduction%grp3D, color, key)
!
! Create a 3D-row communicator based on the 3D communicator
color = key/(nprows/layers_3D_C_reduction%side3D)
CALL mp_comm_split_direct(layers_3D_C_reduction%grp3D, &
layers_3D_C_reduction%rowgrp3D, color, key)
END IF
ELSE
DBCSR_WARN('Cannot make 3D layers without experimental MPI algorithm enabled!')
END IF
END SUBROUTINE make_layers_3D_C_reduction