Skip to content

Instantly share code, notes, and snippets.

@eschnett

eschnett/mpi.patch Secret

Created March 1, 2022 23:57
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save eschnett/d5ab5ad26d74175aceecc36ae8d632ea to your computer and use it in GitHub Desktop.
Save eschnett/d5ab5ad26d74175aceecc36ae8d632ea to your computer and use it in GitHub Desktop.
Download ZIP
Raw
mpi.patch
diff --git a/exts/dbcsr/src/mm/dbcsr_mm_3d.F b/exts/dbcsr/src/mm/dbcsr_mm_3d.F
index 72f63597f6..be0c824a3e 100644
--- a/exts/dbcsr/src/mm/dbcsr_mm_3d.F
+++ b/exts/dbcsr/src/mm/dbcsr_mm_3d.F
@@ -122,8 +122,8 @@ MODULE dbcsr_mm_3d
data_before_resize, &
trs_stackbuf
INTEGER :: vprow, vpcol
- INTEGER :: grp = mp_comm_null, & ! Global communicator
- subgrp = mp_comm_null ! Communicator for A and B
+ INTEGER :: grp, & ! Global communicator
+ subgrp ! Communicator for A and B
INTEGER :: data_win, meta_win
INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: meta => Null(), &
meta_before_resize => Null(), &
@@ -138,6 +138,10 @@ MODULE dbcsr_mm_3d
has_rma_win = .FALSE.
END TYPE dbcsr_buffer
+ INTERFACE dbcsr_buffer
+ PROCEDURE :: new_dbcsr_buffer
+ END INTERFACE dbcsr_buffer
+
TYPE dbcsr_buffers
TYPE(dbcsr_buffer) :: left, right
END TYPE dbcsr_buffers
@@ -147,9 +151,9 @@ MODULE dbcsr_mm_3d
END TYPE mn_local_sizes
TYPE dbcsr_layers_3D_C_reduction
- INTEGER :: grp = mp_comm_null, &
- grp3D = mp_comm_null, &
- rowgrp3D = mp_comm_null
+ INTEGER :: grp, &
+ grp3D, &
+ rowgrp3D
INTEGER :: num_layers_3D = 1, &
max_num_layers_3D = 1, &
side3D = HUGE(1)
@@ -159,6 +163,10 @@ MODULE dbcsr_mm_3d
INTEGER :: data_type
END TYPE dbcsr_layers_3D_C_reduction
+ INTERFACE dbcsr_layers_3D_C_reduction
+ PROCEDURE new_dbcsr_layers_3D_C_reduction
+ END INTERFACE dbcsr_layers_3D_C_reduction
+
! Buffers
TYPE(dbcsr_buffers), TARGET, SAVE :: buffers_win, &
buffers_1, buffers_2
@@ -185,7 +193,8 @@ MODULE dbcsr_mm_3d
INTEGER, DIMENSION(2), PRIVATE :: requests
INTEGER, DIMENSION(2), PRIVATE :: requests_win_create
- INTEGER :: request_sync_mult = mp_request_null
+ LOGICAL :: have_request_sync_mult = .FALSE.
+ INTEGER :: request_sync_mult
! Buffers used in make_buffers
TYPE(dbcsr_data_obj), TARGET, SAVE :: make_buffers_data_recv, make_buffers_data_send
@@ -200,6 +209,21 @@ MODULE dbcsr_mm_3d
CONTAINS
+ SUBROUTINE dbcsr_mm_3d_init()
+ request_sync_mult = mp_request_null
+ END SUBROUTINE dbcsr_mm_3d_init
+
+ TYPE(dbcsr_buffer) FUNCTION new_dbcsr_buffer()
+ new_dbcsr_buffer%grp = mp_comm_null
+ new_dbcsr_buffer%subgrp = mp_comm_null
+ END FUNCTION new_dbcsr_buffer
+
+ TYPE(dbcsr_layers_3D_C_reduction) FUNCTION new_dbcsr_layers_3D_C_reduction()
+ new_dbcsr_layers_3D_C_reduction%grp = mp_comm_null
+ new_dbcsr_layers_3D_C_reduction%grp3D = mp_comm_null
+ new_dbcsr_layers_3D_C_reduction%rowgrp3D = mp_comm_null
+ END FUNCTION new_dbcsr_layers_3D_C_reduction
+
SUBROUTINE dbcsr_make_buffers(matrix, imgdist, is_left, &
!! Prepare orig images for MPI windows
f_row, l_row, f_col, l_col, &
@@ -279,6 +303,10 @@ CONTAINS
CALL timeset(routineN, handle)
! Sync with previous multiplication
+ IF (.NOT. have_request_sync_mult) THEN
+ have_request_sync_mult = .TRUE.
+ request_sync_mult = mp_request_null
+ END IF
IF (request_sync_mult .NE. mp_request_null) &
DBCSR_ABORT("Multiplications are not in sync!")
!
diff --git a/exts/dbcsr/src/mpi/dbcsr_mpiwrap.F b/exts/dbcsr/src/mpi/dbcsr_mpiwrap.F
index 03127cbbc6..cb0846bec0 100644
--- a/exts/dbcsr/src/mpi/dbcsr_mpiwrap.F
+++ b/exts/dbcsr/src/mpi/dbcsr_mpiwrap.F
@@ -52,21 +52,21 @@ MODULE dbcsr_mpiwrap
! parameters that might be needed
#if defined(__parallel)
- INTEGER, PARAMETER :: MP_STD_REAL = MPI_DOUBLE_PRECISION
- INTEGER, PARAMETER :: MP_STD_COMPLEX = MPI_DOUBLE_COMPLEX
- INTEGER, PARAMETER :: MP_STD_HALF_REAL = MPI_REAL
- INTEGER, PARAMETER :: MP_STD_HALF_COMPLEX = MPI_COMPLEX
+ INTEGER :: MP_STD_REAL
+ INTEGER :: MP_STD_COMPLEX
+ INTEGER :: MP_STD_HALF_REAL
+ INTEGER :: MP_STD_HALF_COMPLEX
LOGICAL, PARAMETER :: dbcsr_is_parallel = .TRUE.
- INTEGER, PARAMETER, PUBLIC :: mp_any_tag = MPI_ANY_TAG
- INTEGER, PARAMETER, PUBLIC :: mp_any_source = MPI_ANY_SOURCE
- INTEGER, PARAMETER, PUBLIC :: mp_comm_null = MPI_COMM_NULL
- INTEGER, PARAMETER, PUBLIC :: mp_comm_self = MPI_COMM_SELF
- INTEGER, PARAMETER, PUBLIC :: mp_comm_world = MPI_COMM_WORLD
- INTEGER, PARAMETER, PUBLIC :: mp_request_null = MPI_REQUEST_NULL
- INTEGER, PARAMETER, PUBLIC :: mp_win_null = MPI_WIN_NULL
- INTEGER, PARAMETER, PUBLIC :: mp_status_size = MPI_STATUS_SIZE
- INTEGER, PARAMETER, PUBLIC :: mp_proc_null = MPI_PROC_NULL
+ INTEGER, PUBLIC :: mp_any_tag
+ INTEGER, PUBLIC :: mp_any_source
+ INTEGER, PUBLIC :: mp_comm_null
+ INTEGER, PUBLIC :: mp_comm_self
+ INTEGER, PUBLIC :: mp_comm_world
+ INTEGER, PUBLIC :: mp_request_null
+ INTEGER, PUBLIC :: mp_win_null
+ INTEGER, PUBLIC :: mp_status_size
+ INTEGER, PUBLIC :: mp_proc_null
! Set max allocatable memory by MPI to 2 GiByte
INTEGER(KIND=MPI_ADDRESS_KIND), PARAMETER, PRIVATE :: mp_max_memory_size = HUGE(INT(1, KIND=int_4))
@@ -79,12 +79,12 @@ MODULE dbcsr_mpiwrap
INTEGER, PARAMETER, PUBLIC :: file_offset = MPI_OFFSET_KIND
INTEGER, PARAMETER, PUBLIC :: address_kind = MPI_ADDRESS_KIND
- INTEGER, PARAMETER, PUBLIC :: file_amode_create = MPI_MODE_CREATE
- INTEGER, PARAMETER, PUBLIC :: file_amode_rdonly = MPI_MODE_RDONLY
- INTEGER, PARAMETER, PUBLIC :: file_amode_wronly = MPI_MODE_WRONLY
- INTEGER, PARAMETER, PUBLIC :: file_amode_rdwr = MPI_MODE_RDWR
- INTEGER, PARAMETER, PUBLIC :: file_amode_excl = MPI_MODE_EXCL
- INTEGER, PARAMETER, PUBLIC :: file_amode_append = MPI_MODE_APPEND
+ INTEGER, PUBLIC :: file_amode_create
+ INTEGER, PUBLIC :: file_amode_rdonly
+ INTEGER, PUBLIC :: file_amode_wronly
+ INTEGER, PUBLIC :: file_amode_rdwr
+ INTEGER, PUBLIC :: file_amode_excl
+ INTEGER, PUBLIC :: file_amode_append
#else
LOGICAL, PARAMETER :: dbcsr_is_parallel = .FALSE.
INTEGER, PARAMETER, PUBLIC :: mp_any_tag = -1
@@ -437,6 +437,29 @@ CONTAINS
!$ INTEGER :: provided_tsl
!$ LOGICAL :: no_threading_support
+ ! Initialize MPI constants
+ MP_STD_REAL = MPI_DOUBLE_PRECISION
+ MP_STD_COMPLEX = MPI_DOUBLE_COMPLEX
+ MP_STD_HALF_REAL = MPI_REAL
+ MP_STD_HALF_COMPLEX = MPI_COMPLEX
+
+ mp_any_tag = MPI_ANY_TAG
+ mp_any_source = MPI_ANY_SOURCE
+ mp_comm_null = MPI_COMM_NULL
+ mp_comm_self = MPI_COMM_SELF
+ mp_comm_world = MPI_COMM_WORLD
+ mp_request_null = MPI_REQUEST_NULL
+ mp_win_null = MPI_WIN_NULL
+ mp_status_size = MPI_STATUS_SIZE
+ mp_proc_null = MPI_PROC_NULL
+
+ file_amode_create = MPI_MODE_CREATE
+ file_amode_rdonly = MPI_MODE_RDONLY
+ file_amode_wronly = MPI_MODE_WRONLY
+ file_amode_rdwr = MPI_MODE_RDWR
+ file_amode_excl = MPI_MODE_EXCL
+ file_amode_append = MPI_MODE_APPEND
+
#if defined(__NO_MPI_THREAD_SUPPORT_CHECK)
! Hack that does not request or check MPI thread support level.
! User asserts that the MPI library will work correctly with
@@ -1004,18 +1027,17 @@ CONTAINS
#if defined(__parallel)
CALL mpi_comm_compare(comm1, comm2, iout, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_compare @ "//routineN)
- SELECT CASE (iout)
- CASE (MPI_IDENT)
+ IF (iout == MPI_IDENT) THEN
res = 0
- CASE (MPI_CONGRUENT)
+ ELSEIF (iout == MPI_CONGRUENT) THEN
res = 1
- CASE (MPI_SIMILAR)
+ ELSEIF (iout == MPI_SIMILAR) THEN
res = 2
- CASE (MPI_UNEQUAL)
+ ELSEIF (iout == MPI_UNEQUAL) THEN
res = 3
- CASE default
+ ELSE
res = 4
- END SELECT
+ ENDIF
#else
MARK_USED(comm1)
MARK_USED(comm2)
diff --git a/src/mpiwrap/message_passing.F b/src/mpiwrap/message_passing.F
index 5435bdaa3..e20309b19 100644
--- a/src/mpiwrap/message_passing.F
+++ b/src/mpiwrap/message_passing.F
@@ -63,21 +63,21 @@ MODULE message_passing
! parameters that might be needed
#if defined(__parallel)
- INTEGER, PARAMETER :: MP_STD_REAL = MPI_DOUBLE_PRECISION
- INTEGER, PARAMETER :: MP_STD_COMPLEX = MPI_DOUBLE_COMPLEX
- INTEGER, PARAMETER :: MP_STD_HALF_REAL = MPI_REAL
- INTEGER, PARAMETER :: MP_STD_HALF_COMPLEX = MPI_COMPLEX
+ INTEGER :: MP_STD_REAL
+ INTEGER :: MP_STD_COMPLEX
+ INTEGER :: MP_STD_HALF_REAL
+ INTEGER :: MP_STD_HALF_COMPLEX
LOGICAL, PARAMETER :: cp2k_is_parallel = .TRUE.
- INTEGER, PARAMETER, PUBLIC :: mp_any_tag = MPI_ANY_TAG
- INTEGER, PARAMETER, PUBLIC :: mp_any_source = MPI_ANY_SOURCE
- INTEGER, PARAMETER, PUBLIC :: mp_comm_null = MPI_COMM_NULL
- INTEGER, PARAMETER, PUBLIC :: mp_comm_self = MPI_COMM_SELF
- INTEGER, PARAMETER, PUBLIC :: mp_comm_world = MPI_COMM_WORLD
- INTEGER, PARAMETER, PUBLIC :: mp_request_null = MPI_REQUEST_NULL
- INTEGER, PARAMETER, PUBLIC :: mp_win_null = MPI_WIN_NULL
- INTEGER, PARAMETER, PUBLIC :: mp_status_size = MPI_STATUS_SIZE
- INTEGER, PARAMETER, PUBLIC :: mp_proc_null = MPI_PROC_NULL
+ INTEGER, PUBLIC :: mp_any_tag
+ INTEGER, PUBLIC :: mp_any_source
+ INTEGER, PUBLIC :: mp_comm_null
+ INTEGER, PUBLIC :: mp_comm_self
+ INTEGER, PUBLIC :: mp_comm_world
+ INTEGER, PUBLIC :: mp_request_null
+ INTEGER, PUBLIC :: mp_win_null
+ INTEGER, PUBLIC :: mp_status_size
+ INTEGER, PUBLIC :: mp_proc_null
! Set max allocatable memory by MPI to 2 GiByte
INTEGER(KIND=MPI_ADDRESS_KIND), PARAMETER, PRIVATE :: mp_max_memory_size = HUGE(INT(1, KIND=int_4))
@@ -89,12 +89,12 @@ MODULE message_passing
INTEGER, PARAMETER, PUBLIC :: file_offset = MPI_OFFSET_KIND
INTEGER, PARAMETER, PUBLIC :: address_kind = MPI_ADDRESS_KIND
- INTEGER, PARAMETER, PUBLIC :: file_amode_create = MPI_MODE_CREATE
- INTEGER, PARAMETER, PUBLIC :: file_amode_rdonly = MPI_MODE_RDONLY
- INTEGER, PARAMETER, PUBLIC :: file_amode_wronly = MPI_MODE_WRONLY
- INTEGER, PARAMETER, PUBLIC :: file_amode_rdwr = MPI_MODE_RDWR
- INTEGER, PARAMETER, PUBLIC :: file_amode_excl = MPI_MODE_EXCL
- INTEGER, PARAMETER, PUBLIC :: file_amode_append = MPI_MODE_APPEND
+ INTEGER, PUBLIC :: file_amode_create
+ INTEGER, PUBLIC :: file_amode_rdonly
+ INTEGER, PUBLIC :: file_amode_wronly
+ INTEGER, PUBLIC :: file_amode_rdwr
+ INTEGER, PUBLIC :: file_amode_excl
+ INTEGER, PUBLIC :: file_amode_append
#else
LOGICAL, PARAMETER :: cp2k_is_parallel = .FALSE.
INTEGER, PARAMETER, PUBLIC :: mp_any_tag = -1
@@ -730,6 +730,29 @@ CONTAINS
!$ INTEGER :: provided_tsl
!$ LOGICAL :: no_threading_support
+ ! Initialize MPI constants
+ MP_STD_REAL = MPI_DOUBLE_PRECISION
+ MP_STD_COMPLEX = MPI_DOUBLE_COMPLEX
+ MP_STD_HALF_REAL = MPI_REAL
+ MP_STD_HALF_COMPLEX = MPI_COMPLEX
+
+ mp_any_tag = MPI_ANY_TAG
+ mp_any_source = MPI_ANY_SOURCE
+ mp_comm_null = MPI_COMM_NULL
+ mp_comm_self = MPI_COMM_SELF
+ mp_comm_world = MPI_COMM_WORLD
+ mp_request_null = MPI_REQUEST_NULL
+ mp_win_null = MPI_WIN_NULL
+ mp_status_size = MPI_STATUS_SIZE
+ mp_proc_null = MPI_PROC_NULL
+
+ file_amode_create = MPI_MODE_CREATE
+ file_amode_rdonly = MPI_MODE_RDONLY
+ file_amode_wronly = MPI_MODE_WRONLY
+ file_amode_rdwr = MPI_MODE_RDWR
+ file_amode_excl = MPI_MODE_EXCL
+ file_amode_append = MPI_MODE_APPEND
+
#if defined(__NO_MPI_THREAD_SUPPORT_CHECK)
! Hack that does not request or check MPI thread support level.
! User asserts that the MPI library will work correctly with
@@ -1395,18 +1418,17 @@ CONTAINS
#if defined(__parallel)
CALL mpi_comm_compare(comm1, comm2, iout, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_compare @ mp_comm_compare")
- SELECT CASE (iout)
- CASE (MPI_IDENT)
+ IF (iout == MPI_IDENT) THEN
res = 0
- CASE (MPI_CONGRUENT)
+ ELSEIF (iout == MPI_CONGRUENT) THEN
res = 1
- CASE (MPI_SIMILAR)
+ ELSEIF (iout == MPI_SIMILAR) THEN
res = 2
- CASE (MPI_UNEQUAL)
+ ELSEIF (iout == MPI_UNEQUAL) THEN
res = 3
- CASE default
+ ELSE
res = 4
- END SELECT
+ ENDIF
#else
MARK_USED(comm1)
MARK_USED(comm2)
diff --git a/src/pw/fft_tools.F b/src/pw/fft_tools.F
index 65b677663..b30dd41d1 100644
--- a/src/pw/fft_tools.F
+++ b/src/pw/fft_tools.F
@@ -80,7 +80,7 @@ MODULE fft_tools
INTEGER :: group
INTEGER, DIMENSION(3) :: nfft
! to be used in cube_transpose_* routines
- INTEGER, DIMENSION(2) :: cart_sub_comm = mp_comm_null, dim, pos
+ INTEGER, DIMENSION(2) :: cart_sub_comm, dim, pos
! to be used in fft3d_s
COMPLEX(KIND=dp), DIMENSION(:, :, :), POINTER &
:: ziptr, zoptr
@@ -116,6 +116,10 @@ MODULE fft_tools
INTEGER :: last_tick
END TYPE fft_scratch_type
+ INTERFACE fft_scratch_type
+ PROCEDURE new_fft_scratch_type
+ END INTERFACE fft_scratch_type
+
TYPE fft_scratch_pool_type
TYPE(fft_scratch_type), POINTER :: fft_scratch
TYPE(fft_scratch_pool_type), POINTER :: fft_scratch_next
@@ -164,6 +168,10 @@ MODULE fft_tools
CONTAINS
+ TYPE(fft_scratch_type) FUNCTION new_fft_scratch_type()
+ new_fft_scratch_type%cart_sub_comm = mp_comm_null
+ END FUNCTION new_fft_scratch_type
+
! **************************************************************************************************
!> \brief ...
!> \param fftlib ...
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment