Skip to content

Generalized indices: mpp_group_update #1853

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
J-Lentz wants to merge 8 commits into
base: main
Choose a base branch
from
Open

Generalized indices: mpp_group_update #1853

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
d616487
Generalized indices for group_update
Mar 3, 2026
abaf31e
Fix build errors
Mar 30, 2026
6c85ef6
Update tests to pass `xdim` and `ydim` arguments
Mar 30, 2026
2495421
Remove new loops within inner loops
Mar 31, 2026
0c4ce8d
Restore mpp_domains_util.inc from main
Mar 31, 2026
04a63a7
Workaround for GFortran bug
Apr 2, 2026
2ff70d8
Use c_ptr in mpp_domains_mod
Apr 2, 2026
58611c4
Document new variables and arguments
Apr 9, 2026
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
138 changes: 68 additions & 70 deletions mpp/include/group_update_pack.inc
View file
Open in desktop

Large diffs are not rendered by default.

34 changes: 16 additions & 18 deletions mpp/include/group_update_unpack.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,56 +17,54 @@
!***********************************************************************

if( group%k_loop_inside ) then
!$OMP parallel do default(none) shared(nunpack,group,nscalar,ptr,nvector,ksize,buffer_start_pos) &
!$OMP private(buffer_pos,pos,m,is, ie, js, je,rotation, &
!$OMP ptr_field, ptr_fieldx, ptr_fieldy, n,k )
!$OMP parallel do default(none) shared(buffer,nunpack,group,nscalar,nvector,ksize,buffer_start_pos) &
!$OMP private(buffer_pos,pos,m,is, ie, js, je,rotation,n,k )
do n = nunpack, 1, -1
buffer_pos = group%unpack_buffer_pos(n) + buffer_start_pos
pos = buffer_pos
is = group%unpack_is(n); ie = group%unpack_ie(n)
js = group%unpack_js(n); je = group%unpack_je(n)
if( group%unpack_type(n) == FIELD_S ) then
do l=1,nscalar ! loop over number of fields
ptr_field = group%addrs_s(l)
do k = 1, ksize
do j = js, je
do i = is, ie
pos = pos + 1
field(i,j,k) = buffer(pos)
!field(i,j,k) = buffer(pos)
call SET_VALUE_ (group, FIELD_S, l, i, j, k, buffer(pos))
end do
end do
end do
end do
else if( group%unpack_type(n) == FIELD_X ) then
do l=1,nvector ! loop over number of fields
ptr_fieldx = group%addrs_x(l)
do k = 1, ksize
do j = js, je
do i = is, ie
pos = pos + 1
fieldx(i,j,k) = buffer(pos)
!fieldx(i,j,k) = buffer(pos)
call SET_VALUE_ (group, FIELD_X, l, i, j, k, buffer(pos))
end do
end do
end do
end do
else if( group%unpack_type(n) == FIELD_Y ) then
do l=1,nvector ! loop over number of fields
ptr_fieldy = group%addrs_y(l)
do k = 1, ksize
do j = js, je
do i = is, ie
pos = pos + 1
fieldy(i,j,k) = buffer(pos)
!fieldy(i,j,k) = buffer(pos)
call SET_VALUE_ (group, FIELD_Y, l, i, j, k, buffer(pos))
end do
end do
end do
end do
endif
enddo
else
!$OMP parallel do default(none) shared(nunpack,group,nscalar,ptr,nvector,ksize,buffer_start_pos) &
!$OMP private(buffer_pos,pos,m,is, ie, js, je,rotation, &
!$OMP ptr_field, ptr_fieldx, ptr_fieldy,n,k)
!$OMP parallel do default(none) shared(buffer,nunpack,group,nscalar,nvector,ksize,buffer_start_pos) &
!$OMP private(buffer_pos,pos,m,is, ie, js, je,rotation,n,k)
do nk = nunpack*ksize, 1, -1
n = (nk-1)/ksize + 1
k = mod((nk-1), ksize) + 1
Expand All @@ -76,31 +74,31 @@ else
js = group%unpack_js(n); je = group%unpack_je(n)
if( group%unpack_type(n) == FIELD_S ) then
do l=1,nscalar ! loop over number of fields
ptr_field = group%addrs_s(l)
do j = js, je
do i = is, ie
pos = pos + 1
field(i,j,k) = buffer(pos)
!field(i,j,k) = buffer(pos)
call SET_VALUE_ (group, FIELD_S, l, i, j, k, buffer(pos))
end do
end do
end do
else if( group%unpack_type(n) == FIELD_X ) then
do l=1,nvector ! loop over number of fields
ptr_fieldx = group%addrs_x(l)
do j = js, je
do i = is, ie
pos = pos + 1
fieldx(i,j,k) = buffer(pos)
!fieldx(i,j,k) = buffer(pos)
call SET_VALUE_ (group, FIELD_X, l, i, j, k, buffer(pos))
end do
end do
end do
else if( group%unpack_type(n) == FIELD_Y ) then
do l=1,nvector ! loop over number of fields
ptr_fieldy = group%addrs_y(l)
do j = js, je
do i = is, ie
pos = pos + 1
fieldy(i,j,k) = buffer(pos)
!fieldy(i,j,k) = buffer(pos)
call SET_VALUE_ (group, FIELD_Y, l, i, j, k, buffer(pos))
end do
end do
end do
Expand Down
4 changes: 2 additions & 2 deletions mpp/include/mpp_data_mpi.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,8 @@ integer, parameter :: mpp_from_pe = -999, ptr_from = -999
!-------------------------------------------------------------------!
! The following data is used in mpp_domains_mod and its components !
!-------------------------------------------------------------------!
real(r8_kind), allocatable :: mpp_domains_stack(:) !< stack used to hold data for domain operations
real(r8_kind), allocatable :: mpp_domains_stack_nonblock(:) !< stack used for non-blocking domain operations
real(r8_kind), allocatable, target :: mpp_domains_stack(:) !< stack used to hold data for domain operations
real(r8_kind), allocatable, target :: mpp_domains_stack_nonblock(:) !< stack used for non-blocking domain operations
!--- some dummy variables with dummy values that will never be used
integer, parameter :: ptr_domains_stack = -999
integer, parameter :: ptr_domains_stack_nonblock = -999
4 changes: 2 additions & 2 deletions mpp/include/mpp_data_nocomm.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,8 @@ integer, parameter :: mpp_from_pe = -999, ptr_from = -999
!-------------------------------------------------------------------!
! The following data is used in mpp_domains_mod and its components !
!-------------------------------------------------------------------!
real(r8_kind), allocatable :: mpp_domains_stack(:)
real(r8_kind), allocatable :: mpp_domains_stack_nonblock(:)
real(r8_kind), allocatable, target :: mpp_domains_stack(:)
real(r8_kind), allocatable, target :: mpp_domains_stack_nonblock(:)
!--- some dummy variables with dummy values that will never be used
integer, parameter :: ptr_domains_stack = -999
integer, parameter :: ptr_domains_stack_nonblock = -999
72 changes: 24 additions & 48 deletions mpp/include/mpp_domains_misc.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1956,70 +1956,46 @@ end subroutine init_nonblock_type
#define MPP_TYPE_ real(r8_kind)
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_REAL8
#undef MPP_CREATE_GROUP_UPDATE_2D_
#define MPP_CREATE_GROUP_UPDATE_2D_ mpp_create_group_update_r8_2d
#undef MPP_CREATE_GROUP_UPDATE_3D_
#define MPP_CREATE_GROUP_UPDATE_3D_ mpp_create_group_update_r8_3d
#undef MPP_CREATE_GROUP_UPDATE_4D_
#define MPP_CREATE_GROUP_UPDATE_4D_ mpp_create_group_update_r8_4d
#undef MPP_CREATE_GROUP_UPDATE_2D_V_
#define MPP_CREATE_GROUP_UPDATE_2D_V_ mpp_create_group_update_r8_2dv
#undef MPP_CREATE_GROUP_UPDATE_3D_V_
#define MPP_CREATE_GROUP_UPDATE_3D_V_ mpp_create_group_update_r8_3dv
#undef MPP_CREATE_GROUP_UPDATE_4D_V_
#define MPP_CREATE_GROUP_UPDATE_4D_V_ mpp_create_group_update_r8_4dv
#undef MPP_CREATE_GROUP_UPDATE_
#define MPP_CREATE_GROUP_UPDATE_ mpp_create_group_update_r8
#undef MPP_CREATE_GROUP_UPDATE_V_
#define MPP_CREATE_GROUP_UPDATE_V_ mpp_create_group_update_r8_v
#undef MPP_DO_GROUP_UPDATE_
#define MPP_DO_GROUP_UPDATE_ mpp_do_group_update_r8
#undef MPP_START_GROUP_UPDATE_
#define MPP_START_GROUP_UPDATE_ mpp_start_group_update_r8
#undef MPP_COMPLETE_GROUP_UPDATE_
#define MPP_COMPLETE_GROUP_UPDATE_ mpp_complete_group_update_r8
#undef MPP_RESET_GROUP_UPDATE_FIELD_2D_
#define MPP_RESET_GROUP_UPDATE_FIELD_2D_ mpp_reset_group_update_field_r8_2d
#undef MPP_RESET_GROUP_UPDATE_FIELD_3D_
#define MPP_RESET_GROUP_UPDATE_FIELD_3D_ mpp_reset_group_update_field_r8_3d
#undef MPP_RESET_GROUP_UPDATE_FIELD_4D_
#define MPP_RESET_GROUP_UPDATE_FIELD_4D_ mpp_reset_group_update_field_r8_4d
#undef MPP_RESET_GROUP_UPDATE_FIELD_2D_V_
#define MPP_RESET_GROUP_UPDATE_FIELD_2D_V_ mpp_reset_group_update_field_r8_2dv
#undef MPP_RESET_GROUP_UPDATE_FIELD_3D_V_
#define MPP_RESET_GROUP_UPDATE_FIELD_3D_V_ mpp_reset_group_update_field_r8_3dv
#undef MPP_RESET_GROUP_UPDATE_FIELD_4D_V_
#define MPP_RESET_GROUP_UPDATE_FIELD_4D_V_ mpp_reset_group_update_field_r8_4dv
#undef MPP_RESET_GROUP_UPDATE_FIELD_
#define MPP_RESET_GROUP_UPDATE_FIELD_ mpp_reset_group_update_field_r8
#undef MPP_RESET_GROUP_UPDATE_FIELD_V_
#define MPP_RESET_GROUP_UPDATE_FIELD_V_ mpp_reset_group_update_field_r8_v
#undef GET_VALUE_
#define GET_VALUE_ get_value_r8
#undef SET_VALUE_
#define SET_VALUE_ set_value_r8
#include <mpp_group_update.fh>

#undef MPP_TYPE_
#define MPP_TYPE_ real(r4_kind)
#undef MPI_TYPE_
#define MPI_TYPE_ MPI_REAL4
#undef MPP_CREATE_GROUP_UPDATE_2D_
#define MPP_CREATE_GROUP_UPDATE_2D_ mpp_create_group_update_r4_2d
#undef MPP_CREATE_GROUP_UPDATE_3D_
#define MPP_CREATE_GROUP_UPDATE_3D_ mpp_create_group_update_r4_3d
#undef MPP_CREATE_GROUP_UPDATE_4D_
#define MPP_CREATE_GROUP_UPDATE_4D_ mpp_create_group_update_r4_4d
#undef MPP_CREATE_GROUP_UPDATE_2D_V_
#define MPP_CREATE_GROUP_UPDATE_2D_V_ mpp_create_group_update_r4_2dv
#undef MPP_CREATE_GROUP_UPDATE_3D_V_
#define MPP_CREATE_GROUP_UPDATE_3D_V_ mpp_create_group_update_r4_3dv
#undef MPP_CREATE_GROUP_UPDATE_4D_V_
#define MPP_CREATE_GROUP_UPDATE_4D_V_ mpp_create_group_update_r4_4dv
#undef MPP_CREATE_GROUP_UPDATE_
#define MPP_CREATE_GROUP_UPDATE_ mpp_create_group_update_r4
#undef MPP_CREATE_GROUP_UPDATE_V_
#define MPP_CREATE_GROUP_UPDATE_V_ mpp_create_group_update_r4_v
#undef MPP_DO_GROUP_UPDATE_
#define MPP_DO_GROUP_UPDATE_ mpp_do_group_update_r4
#undef MPP_START_GROUP_UPDATE_
#define MPP_START_GROUP_UPDATE_ mpp_start_group_update_r4
#undef MPP_COMPLETE_GROUP_UPDATE_
#define MPP_COMPLETE_GROUP_UPDATE_ mpp_complete_group_update_r4
#undef MPP_RESET_GROUP_UPDATE_FIELD_2D_
#define MPP_RESET_GROUP_UPDATE_FIELD_2D_ mpp_reset_group_update_field_r4_2d
#undef MPP_RESET_GROUP_UPDATE_FIELD_3D_
#define MPP_RESET_GROUP_UPDATE_FIELD_3D_ mpp_reset_group_update_field_r4_3d
#undef MPP_RESET_GROUP_UPDATE_FIELD_4D_
#define MPP_RESET_GROUP_UPDATE_FIELD_4D_ mpp_reset_group_update_field_r4_4d
#undef MPP_RESET_GROUP_UPDATE_FIELD_2D_V_
#define MPP_RESET_GROUP_UPDATE_FIELD_2D_V_ mpp_reset_group_update_field_r4_2dv
#undef MPP_RESET_GROUP_UPDATE_FIELD_3D_V_
#define MPP_RESET_GROUP_UPDATE_FIELD_3D_V_ mpp_reset_group_update_field_r4_3dv
#undef MPP_RESET_GROUP_UPDATE_FIELD_4D_V_
#define MPP_RESET_GROUP_UPDATE_FIELD_4D_V_ mpp_reset_group_update_field_r4_4dv
#undef MPP_RESET_GROUP_UPDATE_FIELD_
#define MPP_RESET_GROUP_UPDATE_FIELD_ mpp_reset_group_update_field_r4
#undef MPP_RESET_GROUP_UPDATE_FIELD_V_
#define MPP_RESET_GROUP_UPDATE_FIELD_V_ mpp_reset_group_update_field_r4_v
#undef GET_VALUE_
#define GET_VALUE_ get_value_r4
#undef SET_VALUE_
#define SET_VALUE_ set_value_r4
#include <mpp_group_update.fh>
Loading
Loading