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

Replaced pointers with allocatables in mpp modules #1232

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

Replaced pointers with allocatables in mpp modules #1232

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
73b594f
Replaced pointers with allocatables in mpp modules
ganganoaa May 23, 2023
6ab660c
Update mpp_domains_define.inc
ganganoaa May 23, 2023
4b32732
Update mpp_domains_define.inc
ganganoaa May 23, 2023
dd7d42b
Merge branch 'main' into mpp_pointers_replaced
ganganoaa Jul 18, 2023
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
30 changes: 15 additions & 15 deletions mpp/include/mpp_define_nest_domains.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -362,10 +362,10 @@ subroutine mpp_define_nest_domains(nest_domain, domain, num_nest, nest_level, ti
call mpp_error(FATAL, "mpp_define_nest_domains.inc:pos .NE. nest_domain%nest(l)%num_nest")

if(is_nest_fine(l)) then
nest_domain%nest(l)%domain_fine=>domain
nest_domain%nest(l)%domain_fine = domain
allocate(nest_domain%nest(l)%domain_coarse)
else if(is_nest_coarse(l)) then
nest_domain%nest(l)%domain_coarse=>domain
nest_domain%nest(l)%domain_coarse=domain
allocate(nest_domain%nest(l)%domain_fine)
endif
!!!! DEBUG CODE ! has problems on coarse domain
Expand All @@ -385,7 +385,7 @@ end subroutine mpp_define_nest_domains
!! Computes new overlaps of nest PEs on parent PEs
!! Ramstrom/HRD Moving Nest
subroutine mpp_shift_nest_domains(nest_domain, domain, delta_i_coarse, delta_j_coarse, extra_halo)
type(nest_domain_type), intent(inout) :: nest_domain !< holds the information to pass data
type(nest_domain_type), target, intent(inout) :: nest_domain !< holds the information to pass data
!! between nest and parent grids.
type(domain2D), target, intent(in ) :: domain !< domain for the grid defined in the current pelist
integer, intent(in ) :: delta_i_coarse(:) !< Array of deltas of coarse grid in y direction
Expand Down Expand Up @@ -602,7 +602,7 @@ end subroutine define_nest_level_type

!###############################################################################
subroutine compute_overlap_coarse_to_fine(nest_domain, overlap, extra_halo, position, name)
type(nest_level_type), intent(inout) :: nest_domain
type(nest_level_type), intent(inout), target :: nest_domain
type(nestSpec), intent(inout) :: overlap
integer, intent(in ) :: extra_halo
integer, intent(in ) :: position
Expand Down Expand Up @@ -1108,7 +1108,7 @@ end subroutine compute_overlap_coarse_to_fine
!> This routine will compute the send and recv information between overlapped nesting
!! region. The data is assumed on T-cell center.
subroutine compute_overlap_fine_to_coarse(nest_domain, overlap, position, name)
type(nest_level_type), intent(inout) :: nest_domain
type(nest_level_type), intent(inout), target :: nest_domain
type(nestSpec), intent(inout) :: overlap
integer, intent(in ) :: position
character(len=*), intent(in ) :: name
Expand Down Expand Up @@ -1446,7 +1446,7 @@ subroutine allocate_nest_overlap(overlap, count)

overlap%count = 0
overlap%pe = NULL_PE
if( ASSOCIATED(overlap%is) ) call mpp_error(FATAL, &
if( ALLOCATED(overlap%is) ) call mpp_error(FATAL, &
"mpp_define_nest_domains.inc: overlap is already been allocated")

allocate(overlap%is (count) )
Expand Down Expand Up @@ -1525,7 +1525,7 @@ subroutine copy_nest_overlap(overlap_out, overlap_in)
if(overlap_in%count == 0) call mpp_error(FATAL, &
"mpp_define_nest_domains.inc: overlap_in%count is 0")

if(associated(overlap_out%is)) call mpp_error(FATAL, &
if(allocated(overlap_out%is)) call mpp_error(FATAL, &
"mpp_define_nest_domains.inc: overlap_out is already been allocated")

call allocate_nest_overlap(overlap_out, overlap_in%count)
Expand All @@ -1549,7 +1549,7 @@ end subroutine copy_nest_overlap
! this routine found the domain has the same halo size with the input
! whalo, ehalo,
function search_C2F_nest_overlap(nest_domain, nest_level, extra_halo, position)
type(nest_domain_type), intent(inout) :: nest_domain
type(nest_domain_type), intent(inout), target :: nest_domain
integer, intent(in) :: extra_halo
integer, intent(in) :: position, nest_level
type(nestSpec), pointer :: search_C2F_nest_overlap
Expand Down Expand Up @@ -1581,7 +1581,7 @@ function search_C2F_nest_overlap(nest_domain, nest_level, extra_halo, position)
exit ! found domain
endif
!--- if not found, switch to next
if(.NOT. ASSOCIATED(search_C2F_nest_overlap%next)) then
if(.NOT. ALLOCATED(search_C2F_nest_overlap%next)) then
allocate(search_C2F_nest_overlap%next)
search_C2F_nest_overlap => search_C2F_nest_overlap%next
call compute_overlap_coarse_to_fine(nest_domain%nest(nest_level), search_C2F_nest_overlap, &
Expand All @@ -1601,7 +1601,7 @@ function search_C2F_nest_overlap(nest_domain, nest_level, extra_halo, position)
! this routine found the domain has the same halo size with the input
! whalo, ehalo,
function search_F2C_nest_overlap(nest_domain, nest_level, position)
type(nest_domain_type), intent(inout) :: nest_domain
type(nest_domain_type), intent(inout), target :: nest_domain
integer, intent(in) :: position, nest_level
type(nestSpec), pointer :: search_F2C_nest_overlap

Expand Down Expand Up @@ -1638,7 +1638,7 @@ function search_C2F_nest_overlap(nest_domain, nest_level, extra_halo, position)
subroutine mpp_get_C2F_index(nest_domain, is_fine, ie_fine, js_fine, je_fine, &
is_coarse, ie_coarse, js_coarse, je_coarse, dir, nest_level, position)

type(nest_domain_type), intent(in ) :: nest_domain !< holds the information to pass data
type(nest_domain_type), intent(in ), target :: nest_domain !< holds the information to pass data
!! between fine and coarse grids
integer, intent(out) :: is_fine, ie_fine, js_fine, je_fine !< index in the fine
!! grid of the nested region
Expand Down Expand Up @@ -1719,7 +1719,7 @@ function search_C2F_nest_overlap(nest_domain, nest_level, extra_halo, position)
subroutine mpp_get_F2C_index_fine(nest_domain, is_coarse, ie_coarse, js_coarse, je_coarse, &
is_fine, ie_fine, js_fine, je_fine, nest_level, position)

type(nest_domain_type), intent(in ) :: nest_domain !< Holds the information to pass data
type(nest_domain_type), intent(in ), target :: nest_domain !< Holds the information to pass data
!! between fine and coarse grid.
integer, intent(out) :: is_fine, ie_fine, js_fine, je_fine !< index in the fine
!! grid of the nested region
Expand Down Expand Up @@ -1767,7 +1767,7 @@ function search_C2F_nest_overlap(nest_domain, nest_level, extra_halo, position)
!################################################################
subroutine mpp_get_F2C_index_coarse(nest_domain, is_coarse, ie_coarse, js_coarse, je_coarse, nest_level, position)

type(nest_domain_type), intent(in ) :: nest_domain !< Holds the information to pass data
type(nest_domain_type), intent(in ), target :: nest_domain !< Holds the information to pass data
!! between fine and coarse grid.
integer, intent(out) :: is_coarse, ie_coarse, js_coarse, je_coarse !< index in the fine
!! grid of the nested region
Expand Down Expand Up @@ -2467,7 +2467,7 @@ function search_C2F_nest_overlap(nest_domain, nest_level, extra_halo, position)
end subroutine check_data_size_2d

function mpp_get_nest_coarse_domain(nest_domain, nest_level)
type(nest_domain_type), intent(in) :: nest_domain
type(nest_domain_type), intent(in), target :: nest_domain
integer, intent(in) :: nest_level
type(domain2d), pointer :: mpp_get_nest_coarse_domain

Expand All @@ -2482,7 +2482,7 @@ function search_C2F_nest_overlap(nest_domain, nest_level, extra_halo, position)
end function mpp_get_nest_coarse_domain

function mpp_get_nest_fine_domain(nest_domain, nest_level)
type(nest_domain_type), intent(in) :: nest_domain
type(nest_domain_type), intent(in), target :: nest_domain
integer, intent(in) :: nest_level
type(domain2d), pointer :: mpp_get_nest_fine_domain

Expand Down
2 changes: 1 addition & 1 deletion mpp/include/mpp_do_update.fh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@
subroutine MPP_DO_UPDATE_3D_( f_addrs, domain, update, d_type, ke, flags)
integer(i8_kind), intent(in) :: f_addrs(:,:)
type(domain2D), intent(in) :: domain
type(overlapSpec), intent(in) :: update
type(overlapSpec), intent(in), target :: update
MPP_TYPE_, intent(in) :: d_type ! creates unique interface
integer, intent(in) :: ke
integer, optional, intent(in) :: flags
Expand Down
2 changes: 1 addition & 1 deletion mpp/include/mpp_do_update_ad.fh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@
subroutine MPP_DO_UPDATE_AD_3D_( f_addrs, domain, update, d_type, ke, flags)
integer(i8_kind), intent(in) :: f_addrs(:,:)
type(domain2D), intent(in) :: domain
type(overlapSpec), intent(in) :: update
type(overlapSpec), intent(in), target :: update
MPP_TYPE_, intent(in) :: d_type ! creates unique interface
integer, intent(in) :: ke
integer, optional, intent(in) :: flags
Expand Down
10 changes: 5 additions & 5 deletions mpp/include/mpp_do_update_nest.fh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ subroutine MPP_DO_UPDATE_NEST_FINE_3D_(f_addrs, nest_domain, update, d_type, ke,
integer, intent(in) :: xbegin, xend, ybegin, yend

character(len=8) :: text
type(overlap_type), pointer :: overPtr => NULL()
type(overlap_type), allocatable :: overPtr
logical :: send(8), recv(8)
integer :: from_pe, to_pe, dir
integer :: m, n, l, i, j, k
Expand Down Expand Up @@ -68,7 +68,7 @@ subroutine MPP_DO_UPDATE_NEST_FINE_3D_(f_addrs, nest_domain, update, d_type, ke,
!--- pre-post receiving
buffer_pos = 0
do m = 1, update%nrecv
overPtr => update%recv(m)
overPtr = update%recv(m)
if( overPtr%count == 0 )cycle
call mpp_clock_begin(nest_recv_clock)
msgsize = 0
Expand Down Expand Up @@ -98,7 +98,7 @@ subroutine MPP_DO_UPDATE_NEST_FINE_3D_(f_addrs, nest_domain, update, d_type, ke,

!--- pack and send the data
do m = 1, update%nsend
overPtr => update%send(m)
overPtr = update%send(m)
if( overPtr%count == 0 )cycle
call mpp_clock_begin(nest_pack_clock)
pos = buffer_pos
Expand Down Expand Up @@ -185,7 +185,7 @@ subroutine MPP_DO_UPDATE_NEST_FINE_3D_(f_addrs, nest_domain, update, d_type, ke,

call mpp_clock_begin(nest_unpk_clock)
do m = update%nrecv, 1, -1
overPtr => update%recv(m)
overPtr = update%recv(m)
if( overPtr%count == 0 )cycle

pos = buffer_pos
Expand Down Expand Up @@ -684,7 +684,7 @@ subroutine MPP_DO_UPDATE_NEST_COARSE_3D_(f_addrs_in, f_addrs_out, nest_domain, u
integer(i8_kind), intent(in) :: f_addrs_in(:)
integer(i8_kind), intent(in) :: f_addrs_out(:)
type(nest_domain_type), intent(in) :: nest_domain
type(nestSpec), intent(in) :: update
type(nestSpec), intent(in), target :: update
MPP_TYPE_, intent(in) :: d_type ! creates unique interface
integer, intent(in) :: ke

Expand Down
Loading