Skip to content

Remove some cray pointers from mpp/ (part 1) #1793

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
foxtran wants to merge 5 commits into
base: main
Choose a base branch
from
Open

Remove some cray pointers from mpp/ (part 1) #1793

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
f75ed61
Avoid cray pointers in mpp_sum.inc
foxtran Sep 10, 2025
855683f
Avoid cray pointers in mpp_sum_ad.inc
foxtran Sep 10, 2025
6e3ecf3
Replace cray pointers with pointers with Fortran 2008 semantic in mpp…
foxtran Sep 10, 2025
c2c905c
Avoid cray pointers in mpp_transmit_mpi.fh
foxtran Sep 10, 2025
bc3272a
Use Fortran standartized way to compare pointers
foxtran Nov 20, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 12 additions & 16 deletions mpp/include/mpp_sum.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
28 changes: 12 additions & 16 deletions mpp/include/mpp_sum_ad.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
114 changes: 50 additions & 64 deletions mpp/include/mpp_transmit.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
integer, 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, &
Expand All @@ -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
integer, 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 )

Expand All @@ -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
integer, 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 )

Expand All @@ -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
integer, 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 )

Expand All @@ -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
integer, 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 )

Expand Down Expand Up @@ -172,39 +163,39 @@

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
integer, 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 )

end subroutine MPP_RECV_SCALAR_

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
integer, 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 )

Expand Down Expand Up @@ -305,14 +296,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
Expand All @@ -322,13 +312,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
Expand All @@ -338,13 +327,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
Expand All @@ -354,13 +342,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
Expand All @@ -370,13 +357,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
Expand Down
Loading
Loading