Make communicators for A and B matrices
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | my_num_layers_3D | |||
integer, | intent(in) | :: | side3D | |||
type(dbcsr_mp_obj), | intent(in) | :: | mp_obj | |||
logical, | intent(in) | :: | is_left | |||
type(dbcsr_buffer), | intent(inout) | :: | buffer |
SUBROUTINE make_layers_3D_AB(my_num_layers_3D, side3D, mp_obj, is_left, buffer)
!! Make communicators for A and B matrices
INTEGER, INTENT(IN) :: my_num_layers_3D, side3D
TYPE(dbcsr_mp_obj), INTENT(IN) :: mp_obj
LOGICAL, INTENT(IN) :: is_left
TYPE(dbcsr_buffer), INTENT(INOUT) :: buffer
INTEGER :: color, key, mygrp, mypcol, myprow
! Switch to single layer communicator
IF (my_num_layers_3D .LE. 1) THEN
IF (buffer%num_layers_3D .GT. 1 .AND. buffer%subgrp .NE. mp_comm_null) &
CALL mp_comm_free(buffer%subgrp)
buffer%num_layers_3D = 1
IF (is_left) THEN
buffer%subgrp = dbcsr_mp_my_row_group(mp_obj)
ELSE
buffer%subgrp = dbcsr_mp_my_col_group(mp_obj)
END IF
RETURN
END IF
!
! Check if any existing 3D communicator can be reused
mygrp = dbcsr_mp_group(mp_obj)
IF (buffer%grp .EQ. mygrp .AND. buffer%num_layers_3D .EQ. my_num_layers_3D) RETURN
!
! Reset previous 3D communicator
IF (buffer%num_layers_3D .GT. 1 .AND. buffer%subgrp .NE. mp_comm_null) &
CALL mp_comm_free(buffer%subgrp)
!
myprow = dbcsr_mp_myprow(mp_obj)
mypcol = dbcsr_mp_mypcol(mp_obj)
IF (is_left) THEN
color = MOD(myprow, side3D)
! Column-major order
key = mypcol*(dbcsr_mp_nprows(mp_obj)/side3D) + myprow/side3D
ELSE
color = MOD(mypcol, side3D)
! Row-major order
key = myprow*(dbcsr_mp_npcols(mp_obj)/side3D) + mypcol/side3D
END IF
CALL mp_comm_split_direct(mygrp, buffer%subgrp, color, key)
buffer%num_layers_3D = my_num_layers_3D
END SUBROUTINE make_layers_3D_AB