Skip to content
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

Jump to bottom

Fixes mpp_domains_copy #707

Merged
merged 6 commits into from
Mar 26, 2021
Merged

Fixes mpp_domains_copy #707

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
774e28e
Adds a create_super_grid subroutines, fixes to mpp_copy_domain
Feb 24, 2021
032ba2c
Adds unit test for mpp_domains_copy and mpp_create_supergrid
uramirez8707 Mar 5, 2021
1e5a4e8
Adds doxygen for new subroutines
uramirez8707 Mar 16, 2021
fde2cad
Renames subroutine to mpp_create_super_grid_domain
uramirez8707 Mar 22, 2021
c91f99f
Add a check to prevent mpp_copy_domains from being called twice and l…
uramirez8707 Mar 24, 2021
116521c
Adds information on how to use the function
uramirez8707 Mar 25, 2021
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
178 changes: 170 additions & 8 deletions mpp/include/mpp_domains_util.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -276,6 +276,51 @@
return
end subroutine mpp_get_memory_domain2D

!> @brief Modifies the indices in the domain_axis_spec type to those of the supergrid
subroutine mpp_set_super_grid_indices(grid)
type(domain_axis_spec), intent(inout) :: grid !< domain_axis_spec type

grid%begin = 2*grid%begin-1
grid%end = 2*grid%end+1
grid%size = grid%end-grid%begin+1

end subroutine mpp_set_super_grid_indices

!> @brief Modifies the indices of the input domain to create the supergrid domain
subroutine mpp_create_super_grid(domain)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this name could cause confusion as people might think you are creating a supergrid from domain information. I would suggest a name such as mpp_create_super_grid_domain.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Renames to mpp_create_super_grid_domain in fde2cad

type(domain2D), intent(inout) :: domain !< Input domain

integer :: xbegin !< Begining x indices
integer :: ybegin !< Begining y indices
integer :: xend !< Ending x indices
integer :: yend !< Ending y indices
integer :: xsize !< Size of the x domain
integer :: ysize !< Size of the y domain
integer :: i !< For loops

call mpp_get_global_domain(domain, xbegin=xbegin, xend=xend, ybegin=ybegin, yend=yend, xsize=xsize, ysize=ysize)
call mpp_set_global_domain (domain, 2*xbegin-1, 2*xend+1, 2*ybegin-1, 2*yend+1, 2*(xend-xbegin)+3, 2*(yend-ybegin)+3)

call mpp_get_compute_domain(domain, xbegin=xbegin, xend=xend, ybegin=ybegin, yend=yend, xsize=xsize, ysize=ysize)
call mpp_set_compute_domain (domain, 2*xbegin-1, 2*xend+1, 2*ybegin-1, 2*yend+1, 2*(xend-xbegin)+3, 2*(yend-ybegin)+3)

call mpp_get_data_domain(domain, xbegin=xbegin, xend=xend, ybegin=ybegin, yend=yend, xsize=xsize, ysize=ysize)
call mpp_set_data_domain (domain, 2*xbegin-1, 2*xend+1, 2*ybegin-1, 2*yend+1, 2*(xend-xbegin)+3, 2*(yend-ybegin)+3)

do i=1, size(domain%list(:))
call mpp_set_super_grid_indices(domain%list(i-1)%x(1)%global)
call mpp_set_super_grid_indices(domain%list(i-1)%y(1)%global)

call mpp_set_super_grid_indices(domain%list(i-1)%x(1)%compute)
call mpp_set_super_grid_indices(domain%list(i-1)%y(1)%compute)

!< There is no data domain in domain%list
!call mpp_set_super_grid_indices(domain%list(i-1)%x(1)%data)
!call mpp_set_super_grid_indices(domain%list(i-1)%y(1)%data)
enddo

end subroutine mpp_create_super_grid

!#####################################################################
subroutine mpp_set_compute_domain1D( domain, begin, end, size, is_global )
type(domain1D), intent(inout) :: domain
Expand Down Expand Up @@ -1680,10 +1725,14 @@ end subroutine mpp_get_tile_compute_domains

end subroutine mpp_set_domain_symmetry

!> @brief Copies input 1d domain to the output 1d domain
recursive subroutine mpp_copy_domain1D(domain_in, domain_out)
type(domain1D), intent(in) :: domain_in !< Input domain
type(domain1D), intent(inout) :: domain_out !< Output domain

subroutine mpp_copy_domain1D(domain_in, domain_out)
type(domain1D), intent(in) :: domain_in
type(domain1D), intent(inout) :: domain_out
integer :: i !< For loop
integer :: starting !< Starting bounds
integer :: ending !< Ending bounds

domain_out%compute = domain_in%compute
domain_out%data = domain_in%data
Expand All @@ -1693,16 +1742,29 @@ end subroutine mpp_get_tile_compute_domains
domain_out%pe = domain_in%pe
domain_out%pos = domain_in%pos

if (associated(domain_in%list)) then
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this an actual pointer, or is it something that gets allocated?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It is a pointer that gets allocated.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This should be changed to an allocatable then (in a different PR).

starting = lbound(domain_in%list, 1)
ending = ubound(domain_in%list, 1)
allocate(domain_out%list(starting:ending))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this a pointer or an allocatable?


do i = starting, ending
call mpp_copy_domain1D(domain_in%list(i), domain_out%list(i))
enddo

endif

end subroutine mpp_copy_domain1D

!#################################################################
!z1l: This is not fully implemented. The current purpose is to make
! it work in read_data.
!> @brief Copies input 2d domain to the output 2d domain
subroutine mpp_copy_domain2D(domain_in, domain_out)
type(domain2D), intent(in) :: domain_in
type(domain2D), intent(inout) :: domain_out
type(domain2D), intent(in) :: domain_in !< Input domain
type(domain2D), intent(inout) :: domain_out !< Output domain

integer :: n, ntiles
integer :: n,i !< For loops
integer :: ntiles !< Number of tiles
integer :: starting(2) !< Starting bounds
integer :: ending(2) !< Ending bounds

domain_out%id = domain_in%id
domain_out%pe = domain_in%pe
Expand Down Expand Up @@ -1730,10 +1792,110 @@ end subroutine mpp_get_tile_compute_domains
enddo
domain_out%tile_id = domain_in%tile_id

if (associated(domain_in%pearray)) then
starting = lbound(domain_in%pearray)
ending = ubound(domain_in%pearray)

allocate(domain_out%pearray(starting(1):ending(1), starting(2):ending(2)))
bensonr marked this conversation as resolved.
Show resolved Hide resolved
domain_out%pearray=domain_in%pearray
endif

if (associated(domain_in%tile_id)) then
starting(1) = lbound(domain_in%tile_id,1)
ending(1) = ubound(domain_in%tile_id,1)

allocate(domain_out%tile_id(starting(1):ending(1)))
domain_out%tile_id = domain_in%tile_id
endif

if (associated(domain_in%tile_id_all)) then
starting(1) = lbound(domain_in%tile_id_all,1)
ending(1) = ubound(domain_in%tile_id_all,1)

allocate(domain_out%tile_id_all(starting(1):ending(1)))
domain_out%tile_id_all = domain_in%tile_id_all
endif

if (associated(domain_in%list)) then
starting(1) = lbound(domain_in%list,1)
ending(1) = ubound(domain_in%list,1)

allocate(domain_out%list(starting(1):ending(1)))
do i = starting(1), ending(1)
call mpp_copy_domain2D_spec(domain_in%list(i),domain_out%list(i))
enddo
endif

return

end subroutine mpp_copy_domain2D

!> @brief Copies input 2d domain spec to the output 2d domain spec
subroutine mpp_copy_domain2D_spec(domain2D_spec_in, domain2d_spec_out)
type(domain2D_spec), intent(in) :: domain2D_spec_in !< Input
type(domain2D_spec), intent(out) :: domain2D_spec_out !< Output

integer :: starting !< Starting bounds
integer :: ending !< Ending bounds
integer :: i !< For loop

domain2D_spec_out%pe = domain2D_spec_in%pe
domain2D_spec_out%pos = domain2D_spec_in%pos
domain2D_spec_out%tile_root_pe = domain2D_spec_in%tile_root_pe

if (associated(domain2D_spec_in%tile_id)) then
starting = lbound(domain2D_spec_in%tile_id,1)
ending = ubound(domain2D_spec_in%tile_id,1)

allocate(domain2D_spec_out%tile_id(starting:ending))
domain2D_spec_out%tile_id = domain2D_spec_in%tile_id
endif

if (associated(domain2D_spec_in%x)) then
starting = lbound(domain2D_spec_in%x,1)
ending = ubound(domain2D_spec_in%x,1)

allocate(domain2D_spec_out%x(starting:ending))
do i = starting, ending
call mpp_copy_domain1D_spec(domain2D_spec_in%x(i), domain2D_spec_out%x(i))
enddo
endif

if (associated(domain2D_spec_in%y)) then
starting = lbound(domain2D_spec_in%y,1)
ending = ubound(domain2D_spec_in%y,1)

allocate(domain2D_spec_out%y(starting:ending))
do i = starting, ending
call mpp_copy_domain1D_spec(domain2D_spec_in%y(i), domain2D_spec_out%y(i))
enddo
endif

end subroutine mpp_copy_domain2D_spec

!> @brief Copies input 1d domain spec to the output 1d domain spec
subroutine mpp_copy_domain1D_spec(domain1D_spec_in, domain1D_spec_out)
type(domain1D_spec), intent(in) :: domain1D_spec_in !< Input
type(domain1D_spec), intent(out) :: domain1D_spec_out !< Output

domain1D_spec_out%pos = domain1D_spec_in%pos

call mpp_copy_domain_axis_spec(domain1D_spec_in%compute, domain1D_spec_out%compute)
call mpp_copy_domain_axis_spec(domain1D_spec_in%global, domain1D_spec_out%global)
end subroutine mpp_copy_domain1D_spec

!> @brief Copies input domain_axis_spec to the output domain_axis_spec
subroutine mpp_copy_domain_axis_spec(domain_axis_spec_in, domain_axis_spec_out)
type(domain_axis_spec), intent(in) :: domain_axis_spec_in !< Input
type(domain_axis_spec), intent(out) :: domain_axis_spec_out !< Output

domain_axis_spec_out%begin = domain_axis_spec_in%begin
domain_axis_spec_out%end = domain_axis_spec_in%end
domain_axis_spec_out%size = domain_axis_spec_in%size
domain_axis_spec_out%max_size = domain_axis_spec_in%max_size
domain_axis_spec_out%is_global = domain_axis_spec_in%is_global
end subroutine mpp_copy_domain_axis_spec

!######################################################################
subroutine set_group_update(group, domain)
type(mpp_group_update_type), intent(inout) :: group
Expand Down
1 change: 1 addition & 0 deletions mpp/mpp_domains.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -161,6 +161,7 @@ module mpp_domains_mod
public :: mpp_clear_group_update
public :: mpp_group_update_initialized, mpp_group_update_is_set
public :: mpp_get_global_domains
public :: mpp_create_super_grid

!--- public interface from mpp_domains_reduce.h
public :: mpp_global_field, mpp_global_max, mpp_global_min, mpp_global_sum
Expand Down
8 changes: 6 additions & 2 deletions test_fms/mpp/Makefile.am
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ LDADD = ${top_builddir}/libFMS/libFMS.la

# Build these test programs.
check_PROGRAMS = test_mpp \
test_super_grid \
test_mpp_domains \
test_redistribute_int \
test_mpp_memuse \
Expand Down Expand Up @@ -120,6 +121,7 @@ test_mpp_global_field_ug_SOURCES = \
compare_data_checksums_int.F90 \
test_mpp_global_field_ug.F90
test_mpp_global_sum_ad_SOURCES = test_mpp_global_sum_ad.F90
test_super_grid_SOURCES = test_super_grid.F90

# Run the test programs.
TESTS = test_mpp_domains2.sh \
Expand Down Expand Up @@ -153,7 +155,8 @@ TESTS = test_mpp_domains2.sh \
test_mpp_alltoall.sh \
test_mpp_global_field.sh \
test_mpp_global_field_ug.sh \
test_mpp_global_sum_ad.sh
test_mpp_global_sum_ad.sh \
test_super_grid.sh

# These files will also be included in the distribution.
EXTRA_DIST = input_base.nml \
Expand Down Expand Up @@ -191,7 +194,8 @@ EXTRA_DIST = input_base.nml \
test_mpp_alltoall.sh \
test_mpp_global_field.sh \
test_mpp_global_field_ug.sh \
test_mpp_global_sum_ad.sh
test_mpp_global_sum_ad.sh \
test_super_grid.sh

fill_halo.mod: fill_halo.$(OBJEXT)
compare_data_checksums.mod: compare_data_checksums.$(OBJEXT)
Expand Down
Loading