From e44d8e89db74866c3ddc2382b4d137d00391d98c Mon Sep 17 00:00:00 2001 From: "Igor S. Gerasimov" Date: Wed, 10 Sep 2025 19:51:29 +0200 Subject: [PATCH 1/6] Avoid cray pointers in mpp_sum.inc --- mpp/include/mpp_sum.inc | 28 ++++++++++++---------------- 1 file changed, 12 insertions(+), 16 deletions(-) diff --git a/mpp/include/mpp_sum.inc b/mpp/include/mpp_sum.inc index d81125a7a6..b7d1525c44 100644 --- a/mpp/include/mpp_sum.inc +++ b/mpp/include/mpp_sum.inc @@ -41,13 +41,12 @@ !####################################################################### !> Sums 2d array across pes subroutine MPP_SUM_2D_( a, length, pelist ) - MPP_TYPE_, intent(inout) :: a(:,:) !< 2d array to sum + MPP_TYPE_, target, contiguous, intent(inout) :: a(:,:) !< 2d array to sum integer, intent(in) :: length !< amount of indices in given 2d array integer, intent(in), optional :: pelist(:) !< pelist to calculate sum across - MPP_TYPE_ :: a1D(length) + MPP_TYPE_, pointer :: a1D(:) - pointer( ptr, a1D ) - ptr = LOC(a) + a1D(1:length) => a(:,:) call mpp_sum( a1D, length, pelist ) return @@ -56,13 +55,12 @@ !####################################################################### !> Sums 3d array across pes subroutine MPP_SUM_3D_( a, length, pelist ) - MPP_TYPE_, intent(inout) :: a(:,:,:) !< 3d array to sum + MPP_TYPE_, target, contiguous, intent(inout) :: a(:,:,:) !< 3d array to sum integer, intent(in) :: length !< amount of indices in given 3d array integer, intent(in), optional :: pelist(:) !< pelist to calculate sum across - MPP_TYPE_ :: a1D(length) + MPP_TYPE_, pointer :: a1D(:) - pointer( ptr, a1D ) - ptr = LOC(a) + a1D(1:length) => a(:,:,:) call mpp_sum( a1D, length, pelist ) return @@ -71,13 +69,12 @@ !####################################################################### !> Sums 4d array across pes subroutine MPP_SUM_4D_( a, length, pelist ) - MPP_TYPE_, intent(inout) :: a(:,:,:,:) !< 4d array to sum + MPP_TYPE_, target, contiguous, intent(inout) :: a(:,:,:,:) !< 4d array to sum integer, intent(in) :: length !< amount of indices in given 4d array integer, intent(in), optional :: pelist(:) !< pelist to calculate sum across - MPP_TYPE_ :: a1D(length) + MPP_TYPE_, pointer :: a1D(:) - pointer( ptr, a1D ) - ptr = LOC(a) + a1D(1:length) => a(:,:,:,:) call mpp_sum( a1D, length, pelist ) return @@ -86,13 +83,12 @@ !####################################################################### !> Sums 5d array across pes subroutine MPP_SUM_5D_( a, length, pelist ) - MPP_TYPE_, intent(inout) :: a(:,:,:,:,:) !< 5d array to sum + MPP_TYPE_, target, contiguous, intent(inout) :: a(:,:,:,:,:) !< 5d array to sum integer, intent(in) :: length !< amount of indices in given 5d array integer, intent(in), optional :: pelist(:) !< pelist to calculate sum across - MPP_TYPE_ :: a1D(length) + MPP_TYPE_, pointer :: a1D(:) - pointer( ptr, a1D ) - ptr = LOC(a) + a1D(1:length) => a(:,:,:,:,:) call mpp_sum( a1D, length, pelist ) return From bb0a3e5b03f175bf291a79113b7a8ff14e74000b Mon Sep 17 00:00:00 2001 From: "Igor S. Gerasimov" Date: Wed, 10 Sep 2025 19:53:53 +0200 Subject: [PATCH 2/6] Avoid cray pointers in mpp_sum_ad.inc --- mpp/include/mpp_sum_ad.inc | 28 ++++++++++++---------------- 1 file changed, 12 insertions(+), 16 deletions(-) diff --git a/mpp/include/mpp_sum_ad.inc b/mpp/include/mpp_sum_ad.inc index ad07137859..f78f38baad 100644 --- a/mpp/include/mpp_sum_ad.inc +++ b/mpp/include/mpp_sum_ad.inc @@ -42,13 +42,12 @@ !####################################################################### !> Sums 2d array across pes subroutine MPP_SUM_2D_AD_( a, length, pelist ) - MPP_TYPE_, intent(inout) :: a(:,:) !< 2d array to sum + MPP_TYPE_, target, contiguous, intent(inout) :: a(:,:) !< 2d array to sum integer, intent(in) :: length !< amount of indices in given 2d array integer, intent(in), optional :: pelist(:) !< pelist to calculate sum across - MPP_TYPE_ :: a1D(length) + MPP_TYPE_, pointer :: a1D(:) - pointer( ptr, a1D ) - ptr = LOC(a) + a1D(1:length) => a(:,:) call mpp_sum_ad( a1D, length, pelist ) return @@ -57,13 +56,12 @@ !####################################################################### !> Sums 3d array across pes subroutine MPP_SUM_3D_AD_( a, length, pelist ) - MPP_TYPE_, intent(inout) :: a(:,:,:) !< 3d array to sum + MPP_TYPE_, target, contiguous, intent(inout) :: a(:,:,:) !< 3d array to sum integer, intent(in) :: length !< amount of indices in given 3d array integer, intent(in), optional :: pelist(:) !< pelist to calculate sum across - MPP_TYPE_ :: a1D(length) + MPP_TYPE_, pointer :: a1D(:) - pointer( ptr, a1D ) - ptr = LOC(a) + a1D(1:length) => a(:,:,:) call mpp_sum_ad( a1D, length, pelist ) return @@ -72,13 +70,12 @@ !####################################################################### !> Sums 4d array across pes subroutine MPP_SUM_4D_AD_( a, length, pelist ) - MPP_TYPE_, intent(inout) :: a(:,:,:,:) !< 4d array to sum + MPP_TYPE_, target, contiguous, intent(inout) :: a(:,:,:,:) !< 4d array to sum integer, intent(in) :: length !< amount of indices in given 4d array integer, intent(in), optional :: pelist(:) !< pelist to calculate sum across - MPP_TYPE_ :: a1D(length) + MPP_TYPE_, pointer :: a1D(:) - pointer( ptr, a1D ) - ptr = LOC(a) + a1D(1:length) => a(:,:,:,:) call mpp_sum_ad( a1D, length, pelist ) return @@ -87,13 +84,12 @@ !####################################################################### !> Sums 5d array across pes subroutine MPP_SUM_5D_AD_( a, length, pelist ) - MPP_TYPE_, intent(inout) :: a(:,:,:,:,:) !< 5d array to sum + MPP_TYPE_, target, contiguous, intent(inout) :: a(:,:,:,:,:) !< 5d array to sum integer, intent(in) :: length !< amount of indices in given 5d array integer, intent(in), optional :: pelist(:) !< pelist to calculate sum across - MPP_TYPE_ :: a1D(length) + MPP_TYPE_, pointer :: a1D(:) - pointer( ptr, a1D ) - ptr = LOC(a) + a1D(1:length) => a(:,:,:,:,:) call mpp_sum_ad( a1D, length, pelist ) return From f3eccf22fc5d9d75ea02dfad827c2e36f171674b Mon Sep 17 00:00:00 2001 From: "Igor S. Gerasimov" Date: Wed, 10 Sep 2025 19:21:07 +0200 Subject: [PATCH 3/6] Replace cray pointers with pointers with Fortran 2008 semantic in mpp_transmit.inc --- mpp/include/mpp_transmit.inc | 114 +++++++++++++++-------------------- 1 file changed, 50 insertions(+), 64 deletions(-) diff --git a/mpp/include/mpp_transmit.inc b/mpp/include/mpp_transmit.inc index b745e71da0..af89d4dea8 100644 --- a/mpp/include/mpp_transmit.inc +++ b/mpp/include/mpp_transmit.inc @@ -31,22 +31,21 @@ subroutine MPP_TRANSMIT_SCALAR_( put_data, to_pe, get_data, from_pe, plen, glen, block, tag, & recv_request, send_request) + use, intrinsic :: iso_c_binding, only: c_f_pointer, c_loc integer, intent(in) :: to_pe, from_pe - MPP_TYPE_, intent(in) :: put_data - MPP_TYPE_, intent(out) :: get_data + MPP_TYPE_, target, intent(in) :: put_data + MPP_TYPE_, target, intent(out) :: get_data integer, optional, intent(in) :: plen, glen logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: recv_request, send_request integer :: put_len, get_len - MPP_TYPE_ :: put_data1D(1), get_data1D(1) - pointer( ptrp, put_data1D ) - pointer( ptrg, get_data1D ) + MPP_TYPE_, pointer :: put_data1D(:), get_data1D(:) get_data = MPP_TYPE_INIT_VALUE - ptrp = LOC(put_data) - ptrg = LOC(get_data) + call c_f_pointer(c_loc(put_data), put_data1D, [1]) + call c_f_pointer(c_loc(get_data), get_data1D, [1]) put_len=1; if(PRESENT(plen))put_len=plen get_len=1; if(PRESENT(glen))get_len=glen call MPP_TRANSMIT_ ( put_data1D, put_len, to_pe, get_data1D, get_len, from_pe, block, tag, & @@ -58,19 +57,17 @@ subroutine MPP_TRANSMIT_2D_( put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, & recv_request, send_request ) integer, intent(in) :: put_len, to_pe, get_len, from_pe - MPP_TYPE_, intent(in) :: put_data(:,:) - MPP_TYPE_, intent(out) :: get_data(:,:) + MPP_TYPE_, target, contiguous, intent(in) :: put_data(:,:) + MPP_TYPE_, target, contiguous, intent(out) :: get_data(:,:) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: recv_request, send_request - MPP_TYPE_ :: put_data1D(put_len), get_data1D(get_len) + MPP_TYPE_, pointer :: put_data1D(:), get_data1D(:) - pointer( ptrp, put_data1D ) - pointer( ptrg, get_data1D ) get_data = MPP_TYPE_INIT_VALUE - ptrp = LOC(put_data) - ptrg = LOC(get_data) + put_data1D(1:put_len) => put_data(:,:) + get_data1D(1:get_len) => get_data(:,:) call mpp_transmit( put_data1D, put_len, to_pe, get_data1D, get_len, from_pe, block, tag, & recv_request=recv_request, send_request=send_request ) @@ -80,19 +77,17 @@ subroutine MPP_TRANSMIT_3D_( put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, & recv_request, send_request ) integer, intent(in) :: put_len, to_pe, get_len, from_pe - MPP_TYPE_, intent(in) :: put_data(:,:,:) - MPP_TYPE_, intent(out) :: get_data(:,:,:) + MPP_TYPE_, target, contiguous, intent(in) :: put_data(:,:,:) + MPP_TYPE_, target, contiguous, intent(out) :: get_data(:,:,:) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: recv_request, send_request - MPP_TYPE_ :: put_data1D(put_len), get_data1D(get_len) + MPP_TYPE_, pointer :: put_data1D(:), get_data1D(:) - pointer( ptrp, put_data1D ) - pointer( ptrg, get_data1D ) get_data = MPP_TYPE_INIT_VALUE - ptrp = LOC(put_data) - ptrg = LOC(get_data) + put_data1D(1:put_len) => put_data(:,:,:) + get_data1D(1:get_len) => get_data(:,:,:) call mpp_transmit( put_data1D, put_len, to_pe, get_data1D, get_len, from_pe, block, tag, & recv_request=recv_request, send_request=send_request ) @@ -102,19 +97,17 @@ subroutine MPP_TRANSMIT_4D_( put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, & recv_request, send_request ) integer, intent(in) :: put_len, to_pe, get_len, from_pe - MPP_TYPE_, intent(in) :: put_data(:,:,:,:) - MPP_TYPE_, intent(out) :: get_data(:,:,:,:) + MPP_TYPE_, target, contiguous, intent(in) :: put_data(:,:,:,:) + MPP_TYPE_, target, contiguous, intent(out) :: get_data(:,:,:,:) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: recv_request, send_request - MPP_TYPE_ :: put_data1D(put_len), get_data1D(get_len) + MPP_TYPE_, pointer :: put_data1D(:), get_data1D(:) - pointer( ptrp, put_data1D ) - pointer( ptrg, get_data1D ) get_data = MPP_TYPE_INIT_VALUE - ptrp = LOC(put_data) - ptrg = LOC(get_data) + put_data1D(1:put_len) => put_data(:,:,:,:) + get_data1D(1:get_len) => get_data(:,:,:,:) call mpp_transmit( put_data1D, put_len, to_pe, get_data1D, get_len, from_pe, block, tag, & recv_request=recv_request, send_request=send_request ) @@ -124,19 +117,17 @@ subroutine MPP_TRANSMIT_5D_( put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, & recv_request, send_request ) integer, intent(in) :: put_len, to_pe, get_len, from_pe - MPP_TYPE_, intent(in) :: put_data(:,:,:,:,:) - MPP_TYPE_, intent(out) :: get_data(:,:,:,:,:) + MPP_TYPE_, target, contiguous, intent(in) :: put_data(:,:,:,:,:) + MPP_TYPE_, target, contiguous, intent(out) :: get_data(:,:,:,:,:) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: recv_request, send_request - MPP_TYPE_ :: put_data1D(put_len), get_data1D(get_len) + MPP_TYPE_, pointer :: put_data1D(:), get_data1D(:) - pointer( ptrp, put_data1D ) - pointer( ptrg, get_data1D ) get_data = MPP_TYPE_INIT_VALUE - ptrp = LOC(put_data) - ptrg = LOC(get_data) + put_data1D(1:put_len) => put_data(:,:,:,:,:) + get_data1D(1:get_len) => get_data(:,:,:,:,:) call mpp_transmit( put_data1D, put_len, to_pe, get_data1D, get_len, from_pe, block, tag, & recv_request=recv_request, send_request=send_request ) @@ -173,21 +164,21 @@ subroutine MPP_RECV_SCALAR_( get_data, from_pe, glen, block, tag, request ) !a mpp_transmit with null arguments on the put side + use, intrinsic :: iso_c_binding, only: c_f_pointer, c_loc integer, intent(in) :: from_pe - MPP_TYPE_, intent(out) :: get_data + MPP_TYPE_, target, intent(out) :: get_data logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request integer, optional, intent(in) :: glen integer :: get_len - MPP_TYPE_ :: get_data1D(1) + MPP_TYPE_, pointer :: get_data1D(:) MPP_TYPE_ :: dummy(1) - pointer( ptr, get_data1D ) get_data = MPP_TYPE_INIT_VALUE - ptr = LOC(get_data) + call c_f_pointer(c_loc(get_data), get_data1D, [1]) get_len=1; if(PRESENT(glen))get_len=glen call mpp_transmit( dummy, 1, NULL_PE, get_data1D, get_len, from_pe, block, tag, recv_request=request ) @@ -195,17 +186,17 @@ subroutine MPP_SEND_SCALAR_( put_data, to_pe, plen, tag, request) !a mpp_transmit with null arguments on the get side + use, intrinsic :: iso_c_binding, only: c_f_pointer, c_loc integer, intent(in) :: to_pe - MPP_TYPE_, intent(in) :: put_data + MPP_TYPE_, target, intent(in) :: put_data integer, optional, intent(in) :: plen integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request integer :: put_len - MPP_TYPE_ :: put_data1D(1) + MPP_TYPE_, pointer :: put_data1D(:) MPP_TYPE_ :: dummy(1) - pointer( ptr, put_data1D ) - ptr = LOC(put_data) + call c_f_pointer(c_loc(put_data), put_data1D, [1]) put_len=1; if(PRESENT(plen))put_len=plen call mpp_transmit( put_data1D, put_len, to_pe, dummy, 1, NULL_PE, tag = tag, send_request=request ) @@ -306,14 +297,13 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_BROADCAST_SCALAR_( broadcast_data, from_pe, pelist ) - MPP_TYPE_, intent(inout) :: broadcast_data + use, intrinsic :: iso_c_binding, only: c_f_pointer, c_loc + MPP_TYPE_, target, intent(inout) :: broadcast_data integer, intent(in) :: from_pe integer, intent(in), optional :: pelist(:) - MPP_TYPE_ :: data1D(1) - - pointer( ptr, data1D ) + MPP_TYPE_, pointer :: data1D(:) - ptr = LOC(broadcast_data) + call c_f_pointer(c_loc(broadcast_data), data1D, [1]) call MPP_BROADCAST_( data1D, 1, from_pe, pelist ) return @@ -323,13 +313,12 @@ !this call was originally bundled in with mpp_transmit, but that doesn't allow !broadcast to a subset of PEs. This version will, and mpp_transmit will remain !backward compatible. - MPP_TYPE_, intent(inout) :: broadcast_data(:,:) + MPP_TYPE_, target, contiguous, intent(inout) :: broadcast_data(:,:) integer, intent(in) :: length, from_pe integer, intent(in), optional :: pelist(:) - MPP_TYPE_ :: data1D(length) + MPP_TYPE_, pointer :: data1D(:) - pointer( ptr, data1D ) - ptr = LOC(broadcast_data) + data1D(1:length) => broadcast_data(:,:) call mpp_broadcast( data1D, length, from_pe, pelist ) return @@ -339,13 +328,12 @@ !this call was originally bundled in with mpp_transmit, but that doesn't allow !broadcast to a subset of PEs. This version will, and mpp_transmit will remain !backward compatible. - MPP_TYPE_, intent(inout) :: broadcast_data(:,:,:) + MPP_TYPE_, target, contiguous, intent(inout) :: broadcast_data(:,:,:) integer, intent(in) :: length, from_pe integer, intent(in), optional :: pelist(:) - MPP_TYPE_ :: data1D(length) + MPP_TYPE_, pointer :: data1D(:) - pointer( ptr, data1D ) - ptr = LOC(broadcast_data) + data1D(1:length) => broadcast_data(:,:,:) call mpp_broadcast( data1D, length, from_pe, pelist ) return @@ -355,13 +343,12 @@ !this call was originally bundled in with mpp_transmit, but that doesn't allow !broadcast to a subset of PEs. This version will, and mpp_transmit will remain !backward compatible. - MPP_TYPE_, intent(inout) :: broadcast_data(:,:,:,:) + MPP_TYPE_, target, contiguous, intent(inout) :: broadcast_data(:,:,:,:) integer, intent(in) :: length, from_pe integer, intent(in), optional :: pelist(:) - MPP_TYPE_ :: data1D(length) + MPP_TYPE_, pointer :: data1D(:) - pointer( ptr, data1D ) - ptr = LOC(broadcast_data) + data1D(1:length) => broadcast_data(:,:,:,:) call mpp_broadcast( data1D, length, from_pe, pelist ) return @@ -371,13 +358,12 @@ !this call was originally bundled in with mpp_transmit, but that doesn't allow !broadcast to a subset of PEs. This version will, and mpp_transmit will remain !backward compatible. - MPP_TYPE_, intent(inout) :: broadcast_data(:,:,:,:,:) + MPP_TYPE_, target, contiguous, intent(inout) :: broadcast_data(:,:,:,:,:) integer, intent(in) :: length, from_pe integer, intent(in), optional :: pelist(:) - MPP_TYPE_ :: data1D(length) + MPP_TYPE_, pointer :: data1D(:) - pointer( ptr, data1D ) - ptr = LOC(broadcast_data) + data1D(1:length) => broadcast_data(:,:,:,:,:) call mpp_broadcast( data1D, length, from_pe, pelist ) return From 236bb34d389e40d9d8cc616f29912a4139678ca7 Mon Sep 17 00:00:00 2001 From: "Igor S. Gerasimov" Date: Wed, 10 Sep 2025 19:47:49 +0200 Subject: [PATCH 4/6] Avoid cray pointers in mpp_transmit_mpi.fh --- mpp/include/mpp_transmit_mpi.fh | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/mpp/include/mpp_transmit_mpi.fh b/mpp/include/mpp_transmit_mpi.fh index d649a984de..4bbebde73a 100644 --- a/mpp/include/mpp_transmit_mpi.fh +++ b/mpp/include/mpp_transmit_mpi.fh @@ -37,10 +37,11 @@ !!caller is responsible for completion checks (mpp_sync_self) before and after subroutine MPP_TRANSMIT_( put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, & & send_request ) + use, intrinsic :: iso_c_binding, only: c_loc integer, intent(in) :: put_len, to_pe, get_len, from_pe - MPP_TYPE_, intent(in) :: put_data(*) - MPP_TYPE_, intent(out) :: get_data(*) + MPP_TYPE_, target, intent(in) :: put_data(*) + MPP_TYPE_, target, intent(out) :: get_data(*) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: recv_request, send_request @@ -89,7 +90,7 @@ if(from_pe.LT.0 .OR. from_pe.GE.npes) call mpp_error(FATAL, 'MPP_TRANSMIT: broadcasting from invalid PE.') if(put_len.GT.get_len) call mpp_error(FATAL, 'MPP_TRANSMIT: size mismatch between put_data and get_data.') if(pe.EQ.from_pe)then - if( LOC(get_data).NE.LOC(put_data) )then + if( get_pointer_address(c_loc(get_data)) /= get_pointer_address(c_loc(put_data)) )then !dir$ IVDEP do i = 1,get_len get_data(i) = put_data(i) From c9b36b7dcdfd3889683eb0192cc1dcba5ca25dd4 Mon Sep 17 00:00:00 2001 From: "Igor S. Gerasimov" Date: Thu, 20 Nov 2025 21:07:25 +0100 Subject: [PATCH 5/6] Use Fortran standartized way to compare pointers --- mpp/include/mpp_transmit_mpi.fh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mpp/include/mpp_transmit_mpi.fh b/mpp/include/mpp_transmit_mpi.fh index 4bbebde73a..8383da11fc 100644 --- a/mpp/include/mpp_transmit_mpi.fh +++ b/mpp/include/mpp_transmit_mpi.fh @@ -37,7 +37,7 @@ !!caller is responsible for completion checks (mpp_sync_self) before and after subroutine MPP_TRANSMIT_( put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, & & send_request ) - use, intrinsic :: iso_c_binding, only: c_loc + use, intrinsic :: iso_c_binding, only: c_loc, c_associated integer, intent(in) :: put_len, to_pe, get_len, from_pe MPP_TYPE_, target, intent(in) :: put_data(*) @@ -90,7 +90,7 @@ if(from_pe.LT.0 .OR. from_pe.GE.npes) call mpp_error(FATAL, 'MPP_TRANSMIT: broadcasting from invalid PE.') if(put_len.GT.get_len) call mpp_error(FATAL, 'MPP_TRANSMIT: size mismatch between put_data and get_data.') if(pe.EQ.from_pe)then - if( get_pointer_address(c_loc(get_data)) /= get_pointer_address(c_loc(put_data)) )then + if( .not.c_associated(c_loc(get_data),c_loc(put_data)) )then !dir$ IVDEP do i = 1,get_len get_data(i) = put_data(i) From 87b9c66f400d5808640b68a3fc2862aaba4291eb Mon Sep 17 00:00:00 2001 From: "Igor S. Gerasimov" Date: Fri, 20 Mar 2026 07:26:56 +0100 Subject: [PATCH 6/6] Use contiguous for multidimensional arrays --- mpp/include/mpp_transmit.inc | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/mpp/include/mpp_transmit.inc b/mpp/include/mpp_transmit.inc index af89d4dea8..5a150cd0c8 100644 --- a/mpp/include/mpp_transmit.inc +++ b/mpp/include/mpp_transmit.inc @@ -205,7 +205,7 @@ subroutine MPP_RECV_2D_( get_data, get_len, from_pe, block, tag, request ) !a mpp_transmit with null arguments on the put side integer, intent(in) :: get_len, from_pe - MPP_TYPE_, intent(out) :: get_data(:,:) + MPP_TYPE_, contiguous, intent(out) :: get_data(:,:) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request @@ -217,7 +217,7 @@ subroutine MPP_SEND_2D_( put_data, put_len, to_pe, tag, request ) !a mpp_transmit with null arguments on the get side integer, intent(in) :: put_len, to_pe - MPP_TYPE_, intent(in) :: put_data(:,:) + MPP_TYPE_, contiguous, intent(in) :: put_data(:,:) integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request MPP_TYPE_ :: dummy(1,1) @@ -227,7 +227,7 @@ subroutine MPP_RECV_3D_( get_data, get_len, from_pe, block, tag, request ) !a mpp_transmit with null arguments on the put side integer, intent(in) :: get_len, from_pe - MPP_TYPE_, intent(out) :: get_data(:,:,:) + MPP_TYPE_, contiguous, intent(out) :: get_data(:,:,:) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request @@ -239,7 +239,7 @@ subroutine MPP_SEND_3D_( put_data, put_len, to_pe, tag, request ) !a mpp_transmit with null arguments on the get side integer, intent(in) :: put_len, to_pe - MPP_TYPE_, intent(in) :: put_data(:,:,:) + MPP_TYPE_, contiguous, intent(in) :: put_data(:,:,:) integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request MPP_TYPE_ :: dummy(1,1,1) @@ -249,7 +249,7 @@ subroutine MPP_RECV_4D_( get_data, get_len, from_pe, block, tag, request ) !a mpp_transmit with null arguments on the put side integer, intent(in) :: get_len, from_pe - MPP_TYPE_, intent(out) :: get_data(:,:,:,:) + MPP_TYPE_, contiguous, intent(out) :: get_data(:,:,:,:) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request @@ -261,7 +261,7 @@ subroutine MPP_SEND_4D_( put_data, put_len, to_pe, tag, request ) !a mpp_transmit with null arguments on the get side integer, intent(in) :: put_len, to_pe - MPP_TYPE_, intent(in) :: put_data(:,:,:,:) + MPP_TYPE_, contiguous, intent(in) :: put_data(:,:,:,:) integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request MPP_TYPE_ :: dummy(1,1,1,1) @@ -271,7 +271,7 @@ subroutine MPP_RECV_5D_( get_data, get_len, from_pe, block, tag, request) !a mpp_transmit with null arguments on the put side integer, intent(in) :: get_len, from_pe - MPP_TYPE_, intent(out) :: get_data(:,:,:,:,:) + MPP_TYPE_, contiguous, intent(out) :: get_data(:,:,:,:,:) logical, intent(in), optional :: block integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request @@ -283,7 +283,7 @@ subroutine MPP_SEND_5D_( put_data, put_len, to_pe, tag, request ) !a mpp_transmit with null arguments on the get side integer, intent(in) :: put_len, to_pe - MPP_TYPE_, intent(in) :: put_data(:,:,:,:,:) + MPP_TYPE_, contiguous, intent(in) :: put_data(:,:,:,:,:) integer, intent(in), optional :: tag type(mpi_request), intent(out), optional :: request MPP_TYPE_ :: dummy(1,1,1,1,1)