diff --git a/mpp/include/mpp_define_nest_domains.inc b/mpp/include/mpp_define_nest_domains.inc index e8eea60d00..4111d2a789 100644 --- a/mpp/include/mpp_define_nest_domains.inc +++ b/mpp/include/mpp_define_nest_domains.inc @@ -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 @@ -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 @@ -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 @@ -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 @@ -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) ) @@ -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) @@ -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 @@ -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, & @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/mpp/include/mpp_do_update.fh b/mpp/include/mpp_do_update.fh index c770d86483..3f6996b4a0 100644 --- a/mpp/include/mpp_do_update.fh +++ b/mpp/include/mpp_do_update.fh @@ -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 diff --git a/mpp/include/mpp_do_update_ad.fh b/mpp/include/mpp_do_update_ad.fh index 7e7382dcb8..721dc1da17 100644 --- a/mpp/include/mpp_do_update_ad.fh +++ b/mpp/include/mpp_do_update_ad.fh @@ -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 diff --git a/mpp/include/mpp_do_update_nest.fh b/mpp/include/mpp_do_update_nest.fh index 4122516da2..6de66809eb 100644 --- a/mpp/include/mpp_do_update_nest.fh +++ b/mpp/include/mpp_do_update_nest.fh @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/mpp/include/mpp_domains_define.inc b/mpp/include/mpp_domains_define.inc index 5da34c5c47..55d983b9ad 100644 --- a/mpp/include/mpp_domains_define.inc +++ b/mpp/include/mpp_domains_define.inc @@ -455,7 +455,7 @@ !################################################################################ !> Define the layout for IO pe's for the given domain subroutine mpp_define_io_domain(domain, io_layout) - type(domain2D), intent(inout) :: domain !< Input 2D domain + type(domain2D), intent(inout), target :: domain !< Input 2D domain integer, intent(in ) :: io_layout(2) !< 2 value io pe layout to define integer :: layout(2) integer :: npes_in_group @@ -477,7 +477,7 @@ layout(1) = size(domain%x(1)%list(:)) layout(2) = size(domain%y(1)%list(:)) - if(ASSOCIATED(domain%io_domain)) call mpp_error(FATAL, & + if(ALLOCATED(domain%io_domain)) call mpp_error(FATAL, & "mpp_domains_define.inc(mpp_define_io_domain): io_domain is already defined") if(mod(layout(1), io_layout(1)) .NE. 0) call mpp_error(FATAL, & @@ -610,7 +610,7 @@ whalo, ehalo, shalo, nhalo, is_mosaic, tile_count, tile_id, complete, x_cyclic_offset, y_cyclic_offset ) integer, intent(in) :: global_indices(:) !<(/ isg, ieg, jsg, jeg /) integer, intent(in) :: layout(:) !< pe layout - type(domain2D), intent(inout) :: domain !< 2D domain decomposition to define + type(domain2D), intent(inout), target :: domain !< 2D domain decomposition to define integer, intent(in), optional :: pelist(0:) !< current pelist to run on integer, intent(in), optional :: xflags, yflags !< directional flag integer, intent(in), optional :: xhalo, yhalo !< halo sizes for x and y indices @@ -654,7 +654,7 @@ integer :: ibegin(0:layout(1)-1), iend(0:layout(1)-1) integer :: jbegin(0:layout(2)-1), jend(0:layout(2)-1) character(len=8) :: text - type(overlapSpec), pointer :: check_T => NULL() + type(overlapSpec), allocatable :: check_T integer :: outunit logical :: send(8), recv(8) @@ -784,7 +784,7 @@ !--- set up 2-D domain decomposition for T, E, C, N and computing overlapping !--- when current tile is the last tile in the mosaic. nlist = size(pesall(:)) - if( .NOT. Associated(domain%x) ) then + if( .NOT. allocated(domain%x) ) then allocate(domain%tileList(1)) domain%tileList(1)%xbegin = global_indices(1) domain%tileList(1)%xend = global_indices(2) @@ -1586,8 +1586,8 @@ end subroutine check_message_size subroutine compute_overlaps( domain, position, update, check, ishift, jshift, x_cyclic_offset, y_cyclic_offset, & whalo, ehalo, shalo, nhalo ) type(domain2D), intent(inout) :: domain - type(overlapSpec), intent(inout), pointer :: update - type(overlapSpec), intent(inout), pointer :: check + type(overlapSpec), intent(inout), allocatable :: update + type(overlapSpec), intent(inout), allocatable :: check integer, intent(in) :: position, ishift, jshift integer, intent(in) :: x_cyclic_offset, y_cyclic_offset integer, intent(in) :: whalo, ehalo, shalo, nhalo @@ -1603,8 +1603,8 @@ end subroutine check_message_size integer :: isd2, ied2, jsd2, jed2 logical :: folded, need_adjust_1, need_adjust_2, need_adjust_3, folded_north type(overlap_type) :: overlap - type(overlap_type), pointer :: overlapList(:)=>NULL() - type(overlap_type), pointer :: checkList(:)=>NULL() + type(overlap_type), allocatable :: overlapList(:) + type(overlap_type), allocatable :: checkList(:) integer :: nsend, nrecv integer :: nsend_check, nrecv_check integer :: unit @@ -1621,7 +1621,7 @@ end subroutine check_message_size !--- when there is only one tile, n will equal to np nlist = size(domain%list(:)) set_check = .false. - if(ASSOCIATED(check)) set_check = .true. + if(ALLOCATED(check)) set_check = .true. allocate(overlapList(MAXLIST) ) if(set_check) allocate(checkList(MAXLIST) ) @@ -3001,7 +3001,7 @@ end subroutine check_message_size !! assumes only one in each direction !! will calculate the overlapping for T,E,C,N-cell seperately. subroutine compute_overlaps_fold_south( domain, position, ishift, jshift) - type(domain2D), intent(inout) :: domain + type(domain2D), intent(inout), target :: domain integer, intent(in) :: position, ishift, jshift integer :: i, m, n, nlist, tMe, tNbr, dir @@ -3012,8 +3012,8 @@ end subroutine check_message_size logical :: folded type(overlap_type) :: overlap type(overlapSpec), pointer :: update=>NULL() - type(overlap_type), pointer :: overlapList(:)=>NULL() - type(overlap_type), pointer :: checkList(:)=>NULL() + type(overlap_type), allocatable :: overlapList(:) + type(overlap_type), allocatable :: checkList(:) type(overlapSpec), pointer :: check =>NULL() integer :: nsend, nrecv integer :: nsend_check, nrecv_check @@ -3646,7 +3646,7 @@ end subroutine check_message_size !! assumes only one in each direction !! will calculate the overlapping for T,E,C,N-cell seperately. subroutine compute_overlaps_fold_west( domain, position, ishift, jshift) - type(domain2D), intent(inout) :: domain + type(domain2D), intent(inout), target :: domain integer, intent(in) :: position, ishift, jshift integer :: j, m, n, nlist, tMe, tNbr, dir @@ -4270,7 +4270,7 @@ end subroutine check_message_size !! will calculate the overlapping for T,E,C,N-cell seperately. !! here assume fold-east and y-cyclic boundary condition subroutine compute_overlaps_fold_east( domain, position, ishift, jshift ) - type(domain2D), intent(inout) :: domain + type(domain2D), intent(inout), target :: domain integer, intent(in) :: position, ishift, jshift integer :: j, m, n, nlist, tMe, tNbr, dir @@ -4986,7 +4986,7 @@ end subroutine check_message_size !! But will return back to solve this problem in the future. subroutine set_overlaps(domain, overlap_in, overlap_out, whalo_out, ehalo_out, shalo_out, nhalo_out) type(domain2d), intent(in) :: domain - type(overlapSpec), intent(in) :: overlap_in + type(overlapSpec), intent(in), target :: overlap_in type(overlapSpec), intent(inout) :: overlap_out integer, intent(in) :: whalo_out, ehalo_out, shalo_out, nhalo_out integer :: nlist, m, n, isoff, ieoff, jsoff, jeoff, rotation @@ -5628,7 +5628,7 @@ end subroutine check_message_size is = max(isc1,isc2); ie = min(iec1,iec2) js = max(jsc1,jsc2); je = min(jec1,jec2) if(ie.GE.is .AND. je.GE.js )then - if(.not. associated(overlapSend(m)%tileMe)) call allocate_update_overlap(overlapSend(m), & + if(.not. allocated(overlapSend(m)%tileMe)) call allocate_update_overlap(overlapSend(m), & & MAXOVERLAP) call insert_overlap_type(overlapSend(m), domain%list(m)%pe, tMe, tNbr, & is, ie, js, je, dir, rotateSend(n), .true. ) @@ -5732,7 +5732,7 @@ end subroutine check_message_size is = max(isd1,isd2); ie = min(ied1,ied2) js = max(jsd1,jsd2); je = min(jed1,jed2) if(ie.GE.is .AND. je.GE.js )then - if(.not. associated(overlapRecv(m)%tileMe)) call allocate_update_overlap(overlapRecv(m), & + if(.not. allocated(overlapRecv(m)%tileMe)) call allocate_update_overlap(overlapRecv(m), & & MAXOVERLAP) call insert_overlap_type(overlapRecv(m), domain%list(m)%pe, tMe, tNbr, & is, ie, js, je, dir, rotateRecv(n), .true.) @@ -5771,7 +5771,7 @@ end subroutine check_message_size ! copy the overlap information into domain. if(nsend >0) then - if(associated(domain%update_T%send)) then + if(allocated(domain%update_T%send)) then do m = 1, domain%update_T%nsend call deallocate_overlap_type(domain%update_T%send(m)) enddo @@ -5837,7 +5837,7 @@ end subroutine check_message_size endif if(nrecv >0) then - if(associated(domain%update_T%recv)) then + if(allocated(domain%update_T%recv)) then do m = 1, domain%update_T%nrecv call deallocate_overlap_type(domain%update_T%recv(m)) enddo @@ -5956,7 +5956,7 @@ end subroutine fill_contact !############################################################################ !> this routine sets the overlapping between tiles for E,C,N-cell based on T-cell overlapping subroutine set_contact_point(domain, position) - type(domain2d), intent(inout) :: domain + type(domain2d), intent(inout), target :: domain integer, intent(in) :: position integer :: ishift, jshift, nlist, list, m, n @@ -6000,7 +6000,7 @@ subroutine set_contact_point(domain, position) call add_update_overlap(overlapList(pos), update_out%send(m)) call deallocate_overlap_type(update_out%send(m)) enddo - if(ASSOCIATED(update_out%send) )deallocate(update_out%send) + if(ALLOCATED(update_out%send) )deallocate(update_out%send) !--- loop over the list of overlapping. nsend = update_in%nsend @@ -6122,7 +6122,7 @@ subroutine set_contact_point(domain, position) call add_update_overlap(overlapList(pos), update_out%recv(m)) call deallocate_overlap_type(update_out%recv(m)) enddo - if(ASSOCIATED(update_out%recv) )deallocate(update_out%recv) + if(ALLOCATED(update_out%recv) )deallocate(update_out%recv) !--- loop over the list of overlapping. nrecv = update_in%nrecv @@ -6204,7 +6204,7 @@ end subroutine set_contact_point !! done on current pe for east boundary for E-cell, north boundary for N-cell, !! East and North boundary for C-cell subroutine set_check_overlap( domain, position ) -type(domain2d), intent(in) :: domain +type(domain2d), intent(in), target :: domain integer, intent(in) :: position integer :: nlist, m, n integer, parameter :: MAXCOUNT = 100 @@ -6368,7 +6368,7 @@ end subroutine set_check_overlap !############################################################################# !> set up the overlapping for boundary if the domain is symmetry. subroutine set_bound_overlap( domain, position ) - type(domain2d), intent(inout) :: domain + type(domain2d), intent(inout), target :: domain integer, intent(in) :: position integer :: m, n, l, count, dr, tMe integer, parameter :: MAXCOUNT = 100 @@ -7660,7 +7660,7 @@ end subroutine mpp_define_null_domain2D subroutine mpp_deallocate_domain1D(domain) type(domain1D), intent(inout) :: domain - if(ASSOCIATED(domain%list)) deallocate(domain%list) + if(ALLOCATED(domain%list)) deallocate(domain%list) end subroutine mpp_deallocate_domain1D @@ -7670,7 +7670,7 @@ subroutine mpp_deallocate_domain2D(domain) type(domain2D), intent(inout) :: domain call deallocate_domain2D_local(domain) - if(ASSOCIATED(domain%io_domain) ) then + if(ALLOCATED(domain%io_domain) ) then call deallocate_domain2D_local(domain%io_domain) deallocate(domain%io_domain) endif @@ -7685,7 +7685,7 @@ integer :: i, ntileMe ntileMe = size(domain%x(:)) -if(ASSOCIATED(domain%pearray))deallocate(domain%pearray) +if(ALLOCATED(domain%pearray))deallocate(domain%pearray) do i = 1, ntileMe call mpp_deallocate_domain1D(domain%x(i)) call mpp_deallocate_domain1D(domain%y(i)) @@ -7693,62 +7693,62 @@ enddo deallocate(domain%x, domain%y, domain%tile_id) ! TODO: Check if these are always allocated -if(ASSOCIATED(domain%tileList)) deallocate(domain%tileList) -if(ASSOCIATED(domain%tile_id_all)) deallocate(domain%tile_id_all) +if(ALLOCATED(domain%tileList)) deallocate(domain%tileList) +if(ALLOCATED(domain%tile_id_all)) deallocate(domain%tile_id_all) -if(ASSOCIATED(domain%list)) then +if(ALLOCATED(domain%list)) then do i = 0, size(domain%list(:))-1 deallocate(domain%list(i)%x, domain%list(i)%y, domain%list(i)%tile_id) enddo deallocate(domain%list) endif -if(ASSOCIATED(domain%check_C)) then +if(ALLOCATED(domain%check_C)) then call deallocate_overlapSpec(domain%check_C) deallocate(domain%check_C) endif -if(ASSOCIATED(domain%check_E)) then +if(ALLOCATED(domain%check_E)) then call deallocate_overlapSpec(domain%check_E) deallocate(domain%check_E) endif -if(ASSOCIATED(domain%check_N)) then +if(ALLOCATED(domain%check_N)) then call deallocate_overlapSpec(domain%check_N) deallocate(domain%check_N) endif -if(ASSOCIATED(domain%bound_C)) then +if(ALLOCATED(domain%bound_C)) then call deallocate_overlapSpec(domain%bound_C) deallocate(domain%bound_C) endif -if(ASSOCIATED(domain%bound_E)) then +if(ALLOCATED(domain%bound_E)) then call deallocate_overlapSpec(domain%bound_E) deallocate(domain%bound_E) endif -if(ASSOCIATED(domain%bound_N)) then +if(ALLOCATED(domain%bound_N)) then call deallocate_overlapSpec(domain%bound_N) deallocate(domain%bound_N) endif -if(ASSOCIATED(domain%update_T)) then +if(ALLOCATED(domain%update_T)) then call deallocate_overlapSpec(domain%update_T) deallocate(domain%update_T) endif -if(ASSOCIATED(domain%update_E)) then +if(ALLOCATED(domain%update_E)) then call deallocate_overlapSpec(domain%update_E) deallocate(domain%update_E) endif -if(ASSOCIATED(domain%update_C)) then +if(ALLOCATED(domain%update_C)) then call deallocate_overlapSpec(domain%update_C) deallocate(domain%update_C) endif -if(ASSOCIATED(domain%update_N)) then +if(ALLOCATED(domain%update_N)) then call deallocate_overlapSpec(domain%update_N) deallocate(domain%update_N) endif @@ -7763,7 +7763,7 @@ subroutine allocate_check_overlap(overlap, count) overlap%count = 0 overlap%pe = NULL_PE - if(associated(overlap%tileMe)) call mpp_error(FATAL, & + if(allocated(overlap%tileMe)) call mpp_error(FATAL, & "allocate_check_overlap(mpp_domains_define): overlap is already been allocated") if(count < 1) call mpp_error(FATAL, & "allocate_check_overlap(mpp_domains_define): count should be a positive integer") @@ -7785,7 +7785,7 @@ subroutine insert_check_overlap(overlap, pe, tileMe, dir, rotation, is, ie, js, overlap%count = overlap%count + 1 count = overlap%count - if(.NOT. associated(overlap%tileMe)) call mpp_error(FATAL, & + if(.NOT. allocated(overlap%tileMe)) call mpp_error(FATAL, & "mpp_domains_define.inc(insert_check_overlap): overlap is not assigned any memory") if(count > size(overlap%tileMe(:)) ) call mpp_error(FATAL, & "mpp_domains_define.inc(insert_check_overlap): overlap%count is greater than size(overlap%tileMe)") @@ -7821,7 +7821,7 @@ subroutine add_check_overlap( overlap_out, overlap_in) "add_check_overlap(mpp_domains_define): overlap_in%count is zero") if(count_out == 0) then - if(associated(overlap_out%tileMe)) call mpp_error(FATAL, & + if(allocated(overlap_out%tileMe)) call mpp_error(FATAL, & "add_check_overlap(mpp_domains_define): overlap is already been allocated but count=0") call allocate_check_overlap(overlap_out, count_in) overlap_out%pe = overlap_in%pe @@ -7875,7 +7875,7 @@ subroutine allocate_update_overlap( overlap, count) overlap%count = 0 overlap%pe = NULL_PE - if(associated(overlap%tileMe)) call mpp_error(FATAL, & + if(allocated(overlap%tileMe)) call mpp_error(FATAL, & "allocate_update_overlap(mpp_domains_define): overlap is already been allocated") if(count < 1) call mpp_error(FATAL, & "allocate_update_overlap(mpp_domains_define): count should be a positive integer") @@ -7983,22 +7983,22 @@ subroutine deallocate_overlap_type( overlap) type(overlap_type), intent(inout) :: overlap if(overlap%count == 0) then - if( .NOT. associated(overlap%tileMe)) return + if( .NOT. allocated(overlap%tileMe)) return else - if( .NOT. associated(overlap%tileMe)) call mpp_error(FATAL, & + if( .NOT. allocated(overlap%tileMe)) call mpp_error(FATAL, & "deallocate_overlap_type(mpp_domains_define): overlap is not been allocated") endif - if(ASSOCIATED(overlap%tileMe)) deallocate(overlap%tileMe) - if(ASSOCIATED(overlap%tileNbr)) deallocate(overlap%tileNbr) - if(ASSOCIATED(overlap%is)) deallocate(overlap%is) - if(ASSOCIATED(overlap%ie)) deallocate(overlap%ie) - if(ASSOCIATED(overlap%js)) deallocate(overlap%js) - if(ASSOCIATED(overlap%je)) deallocate(overlap%je) - if(ASSOCIATED(overlap%dir)) deallocate(overlap%dir) - if(ASSOCIATED(overlap%index)) deallocate(overlap%index) - if(ASSOCIATED(overlap%rotation)) deallocate(overlap%rotation) - if(ASSOCIATED(overlap%from_contact)) deallocate(overlap%from_contact) - if(ASSOCIATED(overlap%msgsize)) deallocate(overlap%msgsize) + if(ALLOCATED(overlap%tileMe)) deallocate(overlap%tileMe) + if(ALLOCATED(overlap%tileNbr)) deallocate(overlap%tileNbr) + if(ALLOCATED(overlap%is)) deallocate(overlap%is) + if(ALLOCATED(overlap%ie)) deallocate(overlap%ie) + if(ALLOCATED(overlap%js)) deallocate(overlap%js) + if(ALLOCATED(overlap%je)) deallocate(overlap%je) + if(ALLOCATED(overlap%dir)) deallocate(overlap%dir) + if(ALLOCATED(overlap%index)) deallocate(overlap%index) + if(ALLOCATED(overlap%rotation)) deallocate(overlap%rotation) + if(ALLOCATED(overlap%from_contact)) deallocate(overlap%from_contact) + if(ALLOCATED(overlap%msgsize)) deallocate(overlap%msgsize) overlap%count = 0 end subroutine deallocate_overlap_type @@ -8008,13 +8008,13 @@ subroutine deallocate_overlapSpec(overlap) type(overlapSpec), intent(inout) :: overlap integer :: n - if(ASSOCIATED(overlap%send)) then + if(ALLOCATED(overlap%send)) then do n = 1, size(overlap%send(:)) call deallocate_overlap_type(overlap%send(n)) enddo deallocate(overlap%send) endif - if(ASSOCIATED(overlap%recv)) then + if(ALLOCATED(overlap%recv)) then do n = 1, size(overlap%recv(:)) call deallocate_overlap_type(overlap%recv(n)) enddo @@ -8040,7 +8040,7 @@ subroutine add_update_overlap( overlap_out, overlap_in) "mpp_domains_define.inc(add_update_overlap): overlap_in%count is zero") if(count_out == 0) then - if(associated(overlap_out%tileMe)) call mpp_error(FATAL, & + if(allocated(overlap_out%tileMe)) call mpp_error(FATAL, & "mpp_domains_define.inc(add_update_overlap): overlap is already been allocated but count=0") call allocate_update_overlap(overlap_out, count_in) overlap_out%pe = overlap_in%pe @@ -8093,9 +8093,9 @@ end subroutine add_update_overlap !############################################################################## subroutine expand_update_overlap_list(overlapList, npes) - type(overlap_type), pointer :: overlapList(:) + type(overlap_type), allocatable, intent(inout) :: overlapList(:) integer, intent(in ) :: npes - type(overlap_type), pointer,save :: newlist(:) => NULL() + type(overlap_type), allocatable, save :: newlist(:) integer :: nlist_old, nlist, m nlist_old = size(overlaplist(:)) @@ -8109,8 +8109,8 @@ subroutine expand_update_overlap_list(overlapList, npes) enddo deallocate(overlapList) - overlaplist => newlist - newlist => NULL() + overlaplist = newlist + if (allocated(newlist)) deallocate(newlist) !newlist => NULL() return @@ -8118,9 +8118,9 @@ end subroutine expand_update_overlap_list !################################################################################## subroutine expand_check_overlap_list(overlaplist, npes) - type(overlap_type), pointer :: overlaplist(:) + type(overlap_type), allocatable, intent(inout) :: overlaplist(:) integer, intent(in) :: npes - type(overlap_type), pointer,save :: newlist(:) => NULL() + type(overlap_type), allocatable,save :: newlist(:) integer :: nlist_old, nlist, m nlist_old = size(overlaplist(:)) @@ -8133,7 +8133,8 @@ subroutine expand_check_overlap_list(overlaplist, npes) call deallocate_overlap_type(overlapList(m)) enddo deallocate(overlapList) - overlaplist => newlist + overlaplist = newlist + if (allocated(newlist)) deallocate(newlist) return diff --git a/mpp/include/mpp_domains_misc.inc b/mpp/include/mpp_domains_misc.inc index 683ffd18a2..352ad140be 100644 --- a/mpp/include/mpp_domains_misc.inc +++ b/mpp/include/mpp_domains_misc.inc @@ -475,7 +475,7 @@ end subroutine init_nonblock_type call mpp_get_current_pelist(pes) !am I part of this domain? - native = ASSOCIATED(domain%list) + native = ALLOCATED(domain%list) !set local list size if( native )then @@ -599,10 +599,10 @@ end subroutine init_nonblock_type call mpp_get_current_pelist(pes) ! domain_in must be initialized - if( .not. ASSOCIATED(domain_in%list) ) then + if( .not. ALLOCATED(domain_in%list) ) then call mpp_error( FATAL, 'MPP_BROADCAST_DOMAIN_2: domain_in is not initialized') endif - if( ASSOCIATED(domain_out%list) ) then + if( ALLOCATED(domain_out%list) ) then call mpp_error( FATAL, 'MPP_BROADCAST_DOMAIN_2: domain_out is already initialized') endif @@ -729,7 +729,7 @@ end subroutine init_nonblock_type call mpp_get_current_pelist(pes) !am I part of this domain? - native = ASSOCIATED(domain%list) + native = ALLOCATED(domain%list) num_nest = size(tile_nest(:)) !set local list size nestsize = 0 @@ -853,7 +853,7 @@ end subroutine init_nonblock_type allocate(tile_pesize(maxtile)) tile_pesize = 0 !am I part of this domain? - native = ASSOCIATED(domain%list) + native = ALLOCATED(domain%list) !set local list size if( native )then ! tile = domain%tile_id(1) diff --git a/mpp/include/mpp_domains_util.inc b/mpp/include/mpp_domains_util.inc index 3d72df4a43..b9927ee79f 100644 --- a/mpp/include/mpp_domains_util.inc +++ b/mpp/include/mpp_domains_util.inc @@ -96,7 +96,7 @@ if( mpp_domain2D_eq .AND. ((a%pe.EQ.NULL_PE).OR.(b%pe.EQ.NULL_PE)) )return !NULL_DOMAIN2D !compare pelists - if( mpp_domain2D_eq )mpp_domain2D_eq = ASSOCIATED(a%list) .AND. ASSOCIATED(b%list) + if( mpp_domain2D_eq )mpp_domain2D_eq = ALLOCATED(a%list) .AND. ALLOCATED(b%list) if( mpp_domain2D_eq )mpp_domain2D_eq = size(a%list(:)).EQ.size(b%list(:)) if( mpp_domain2D_eq )mpp_domain2D_eq = ALL(a%list%pe.EQ.b%list%pe) if( mpp_domain2D_eq )mpp_domain2D_eq = ALL(a%io_layout .EQ. b%io_layout) @@ -690,10 +690,10 @@ function mpp_get_domain_tile_root_pe(domain) end function mpp_get_domain_tile_root_pe function mpp_get_io_domain(domain) - type(domain2d), intent(in) :: domain + type(domain2d), intent(in), target :: domain type(domain2d), pointer :: mpp_get_io_domain - if(ASSOCIATED(domain%io_domain)) then + if(ALLOCATED(domain%io_domain)) then mpp_get_io_domain => domain%io_domain else mpp_get_io_domain => NULL() @@ -951,7 +951,7 @@ end subroutine mpp_get_domain_shift subroutine nullify_domain2d_list(domain) type(domain2d), intent(inout) :: domain - domain%list =>NULL() + if (allocated(domain%list)) deallocate(domain%list) !domain%list =>NULL() end subroutine nullify_domain2d_list @@ -1008,33 +1008,33 @@ end subroutine mpp_get_domain_shift !> this routine found the domain has the same halo size with the input !! whalo, ehalo, function search_update_overlap(domain, whalo, ehalo, shalo, nhalo, position) - type(domain2d), intent(inout) :: domain + type(domain2d), intent(inout), target :: domain integer, intent(in) :: whalo, ehalo, shalo, nhalo integer, intent(in) :: position - type(overlapSpec), pointer :: search_update_overlap - type(overlapSpec), pointer :: update_ref - type(overlapSpec), pointer :: check => NULL() + type(overlapSpec), allocatable :: search_update_overlap + type(overlapSpec), allocatable :: update_ref + type(overlapSpec), allocatable :: check integer :: ishift, jshift, shift shift = 0; if(domain%symmetry) shift = 1 select case(position) case (CENTER) - update_ref => domain%update_T + update_ref = domain%update_T ishift = 0; jshift = 0 case (CORNER) - update_ref => domain%update_C + update_ref = domain%update_C ishift = shift; jshift = shift case (NORTH) - update_ref => domain%update_N + update_ref = domain%update_N ishift = 0; jshift = shift case (EAST) - update_ref => domain%update_E + update_ref = domain%update_E ishift = shift; jshift = 0 case default call mpp_error(FATAL,"mpp_domains_util.inc(search_update_overlap): position should be CENTER|CORNER|EAST|NORTH") end select - search_update_overlap => update_ref + search_update_overlap = update_ref do if(whalo == search_update_overlap%whalo .AND. ehalo == search_update_overlap%ehalo .AND. & @@ -1042,9 +1042,9 @@ end subroutine mpp_get_domain_shift exit ! found domain endif !--- if not found, switch to next - if(.NOT. ASSOCIATED(search_update_overlap%next)) then + if(.NOT. ALLOCATED(search_update_overlap%next)) then allocate(search_update_overlap%next) - search_update_overlap => search_update_overlap%next + search_update_overlap = search_update_overlap%next if(domain%fold .NE. 0) then call compute_overlaps(domain, position, search_update_overlap, check, & ishift, jshift, 0, 0, whalo, ehalo, shalo, nhalo) @@ -1053,19 +1053,19 @@ end subroutine mpp_get_domain_shift endif exit else - search_update_overlap => search_update_overlap%next + search_update_overlap = search_update_overlap%next end if end do - update_ref => NULL() + !update_ref => NULL() end function search_update_overlap !####################################################################### !> this routine finds the check at certain position function search_check_overlap(domain, position) - type(domain2d), intent(in) :: domain + type(domain2d), intent(in), target :: domain integer, intent(in) :: position type(overlapSpec), pointer :: search_check_overlap @@ -1087,7 +1087,7 @@ end subroutine mpp_get_domain_shift !####################################################################### !> This routine finds the bound at certain position function search_bound_overlap(domain, position) - type(domain2d), intent(in) :: domain + type(domain2d), intent(in), target :: domain integer, intent(in) :: position type(overlapSpec), pointer :: search_bound_overlap @@ -1258,7 +1258,7 @@ end subroutine mpp_get_tile_compute_domains !############################################################################# function mpp_get_num_overlap(domain, action, p, position) - type(domain2d), intent(in) :: domain + type(domain2d), intent(in), target :: domain integer, intent(in) :: action integer, intent(in) :: p integer, optional, intent(in) :: position @@ -1325,7 +1325,7 @@ end subroutine mpp_get_tile_compute_domains !############################################################################# subroutine mpp_get_update_pelist(domain, action, pelist, position) - type(domain2d), intent(in) :: domain + type(domain2d), intent(in), target :: domain integer, intent(in) :: action integer, intent(inout) :: pelist(:) integer, optional, intent(in) :: position @@ -1367,7 +1367,7 @@ end subroutine mpp_get_tile_compute_domains !############################################################################# subroutine mpp_get_overlap(domain, action, p, is, ie, js, je, dir, rot, position) - type(domain2d), intent(in) :: domain + type(domain2d), intent(in), target :: domain integer, intent(in) :: action integer, intent(in) :: p integer, dimension(:), intent(out) :: is, ie, js, je @@ -1735,7 +1735,7 @@ 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 + if (allocated(domain_in%list)) then starting = lbound(domain_in%list, 1) ending = ubound(domain_in%list, 1) if (associated(domain_out%list)) deallocate(domain_out%list) !< Check if allocated @@ -1760,7 +1760,7 @@ end subroutine mpp_get_tile_compute_domains integer :: starting(2) !< Starting bounds integer :: ending(2) !< Ending bounds - if (associated(domain_out%x)) then + if (allocated(domain_out%x)) then call mpp_error(FATAL, "mpp_copy_domain: domain_out is already set") endif @@ -1789,7 +1789,7 @@ end subroutine mpp_get_tile_compute_domains call mpp_copy_domain1D(domain_in%y(n), domain_out%y(n)) enddo - if (associated(domain_in%pearray)) then + if (allocated(domain_in%pearray)) then starting = lbound(domain_in%pearray) ending = ubound(domain_in%pearray) @@ -1797,7 +1797,7 @@ end subroutine mpp_get_tile_compute_domains domain_out%pearray=domain_in%pearray endif - if (associated(domain_in%tile_id)) then + if (allocated(domain_in%tile_id)) then starting(1) = lbound(domain_in%tile_id,1) ending(1) = ubound(domain_in%tile_id,1) @@ -1805,7 +1805,7 @@ end subroutine mpp_get_tile_compute_domains domain_out%tile_id = domain_in%tile_id endif - if (associated(domain_in%tile_id_all)) then + if (allocated(domain_in%tile_id_all)) then starting(1) = lbound(domain_in%tile_id_all,1) ending(1) = ubound(domain_in%tile_id_all,1) @@ -1813,7 +1813,7 @@ end subroutine mpp_get_tile_compute_domains domain_out%tile_id_all = domain_in%tile_id_all endif - if (associated(domain_in%list)) then + if (allocated(domain_in%list)) then starting(1) = lbound(domain_in%list,1) ending(1) = ubound(domain_in%list,1) @@ -1840,7 +1840,7 @@ end subroutine mpp_get_tile_compute_domains 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 + if (allocated(domain2D_spec_in%tile_id)) then starting = lbound(domain2D_spec_in%tile_id,1) ending = ubound(domain2D_spec_in%tile_id,1) @@ -1849,7 +1849,7 @@ end subroutine mpp_get_tile_compute_domains domain2D_spec_out%tile_id = domain2D_spec_in%tile_id endif - if (associated(domain2D_spec_in%x)) then + if (allocated(domain2D_spec_in%x)) then starting = lbound(domain2D_spec_in%x,1) ending = ubound(domain2D_spec_in%x,1) @@ -1860,7 +1860,7 @@ end subroutine mpp_get_tile_compute_domains enddo endif - if (associated(domain2D_spec_in%y)) then + if (allocated(domain2D_spec_in%y)) then starting = lbound(domain2D_spec_in%y,1) ending = ubound(domain2D_spec_in%y,1) @@ -1919,10 +1919,10 @@ end subroutine mpp_get_tile_compute_domains integer :: pack_buffer_pos, unpack_buffer_pos integer :: omp_get_num_threads, nthreads character(len=8) :: text - type(overlap_type), pointer :: overPtr => NULL() - type(overlapSpec), pointer :: update_s => NULL() - type(overlapSpec), pointer :: update_x => NULL() - type(overlapSpec), pointer :: update_y => NULL() + type(overlap_type), allocatable :: overPtr + type(overlapSpec), allocatable :: update_s + type(overlapSpec), allocatable :: update_x + type(overlapSpec), allocatable :: update_y nscalar = group%nscalar nvector = group%nvector @@ -1945,13 +1945,13 @@ end subroutine mpp_get_tile_compute_domains call mpp_error(FATAL, "set_group_update: invalid value of gridtype") end select if(nscalar>0) then - update_s => search_update_overlap(domain, group%whalo_s, group%ehalo_s, & + update_s = search_update_overlap(domain, group%whalo_s, group%ehalo_s, & group%shalo_s, group%nhalo_s, group%position) endif if(nvector>0) then - update_x => search_update_overlap(domain, group%whalo_v, group%ehalo_v, & + update_x = search_update_overlap(domain, group%whalo_v, group%ehalo_v, & group%shalo_v, group%nhalo_v, position_x) - update_y => search_update_overlap(domain, group%whalo_v, group%ehalo_v, & + update_y = search_update_overlap(domain, group%whalo_v, group%ehalo_v, & group%shalo_v, group%nhalo_v, position_y) endif @@ -2103,7 +2103,7 @@ end subroutine mpp_get_tile_compute_domains do l = 1, nrecv_old m = ind_s(l) if(m>0) then - overptr => update_s%recv(m) + overptr = update_s%recv(m) do n = 1, overptr%count dir = overptr%dir(n) if(recv_s(dir)) then @@ -2125,7 +2125,7 @@ end subroutine mpp_get_tile_compute_domains m = ind_x(l) if(m>0) then - overptr => update_x%recv(m) + overptr = update_x%recv(m) do n = 1, overptr%count dir = overptr%dir(n) if(recv_x(dir)) then @@ -2147,7 +2147,7 @@ end subroutine mpp_get_tile_compute_domains m = ind_y(l) if(m>0) then - overptr => update_y%recv(m) + overptr = update_y%recv(m) do n = 1, overptr%count dir = overptr%dir(n) if(recv_y(dir)) then @@ -2258,7 +2258,7 @@ end subroutine mpp_get_tile_compute_domains do l = 1, nsend_old m = ind_s(l) if(m>0) then - overptr => update_s%send(m) + overptr = update_s%send(m) do n = 1, overptr%count dir = overptr%dir(n) if(send_s(dir)) then @@ -2280,7 +2280,7 @@ end subroutine mpp_get_tile_compute_domains m = ind_x(l) if(m>0) then - overptr => update_x%send(m) + overptr = update_x%send(m) do n = 1, overptr%count dir = overptr%dir(n) !--- nonsym_edge update is not for rotation of 90 or -90 degree ( cubic sphere grid ) @@ -2308,7 +2308,7 @@ end subroutine mpp_get_tile_compute_domains m = ind_y(l) if(m>0) then - overptr => update_y%send(m) + overptr = update_y%send(m) do n = 1, overptr%count dir = overptr%dir(n) if( group%nonsym_edge .and. (overptr%rotation(n)==NINETY .or. & diff --git a/mpp/include/mpp_unstruct_domain.inc b/mpp/include/mpp_unstruct_domain.inc index 2b88c630a1..f99ebfc2fe 100644 --- a/mpp/include/mpp_unstruct_domain.inc +++ b/mpp/include/mpp_unstruct_domain.inc @@ -389,9 +389,9 @@ return !--- UG2SG is the reverse of SG2UG UG_domain%UG2SG%nsend = UG_domain%SG2UG%nrecv - UG_domain%UG2SG%send => UG_domain%SG2UG%recv + UG_domain%UG2SG%send = UG_domain%SG2UG%recv UG_domain%UG2SG%nrecv = UG_domain%SG2UG%nsend - UG_domain%UG2SG%recv => UG_domain%SG2UG%send + UG_domain%UG2SG%recv = UG_domain%SG2UG%send return @@ -410,10 +410,10 @@ return !#################################################################### function mpp_get_UG_io_domain(domain) - type(domainUG), intent(in) :: domain + type(domainUG), intent(in), target :: domain type(domainUG), pointer :: mpp_get_UG_io_domain - if(ASSOCIATED(domain%io_domain)) then + if(ALLOCATED(domain%io_domain)) then mpp_get_UG_io_domain => domain%io_domain else call mpp_error(FATAL, "mpp_get_UG_io_domain: io_domain is not defined, contact developer") @@ -604,7 +604,7 @@ return call mpp_get_current_pelist(pes) !am I part of this domain? - native = ASSOCIATED(domain%list) + native = ALLOCATED(domain%list) !set local list size if( native )then @@ -696,8 +696,8 @@ end function subroutine deallocate_unstruct_overlap_type(overlap) type(unstruct_overlap_type), intent(inout) :: overlap - if(associated(overlap%i)) deallocate(overlap%i) - if(associated(overlap%j)) deallocate(overlap%j) + if(allocated(overlap%i)) deallocate(overlap%i) + if(allocated(overlap%j)) deallocate(overlap%j) end subroutine deallocate_unstruct_overlap_type @@ -716,15 +716,15 @@ subroutine deallocate_unstruct_pass_type(domain) ! SG2UG%{send,recv} point to the same memory as UG2SG%{send,recv} ! respectively. Thus, we only need to `deallocate` one, and nullify ! the other set. - if(associated(domain%UG2SG%send)) then + if(allocated(domain%UG2SG%send)) then deallocate(domain%UG2SG%send) - nullify(domain%UG2SG%send) - nullify(domain%SG2UG%recv) + !nullify(domain%UG2SG%send) + !nullify(domain%SG2UG%recv) end if - if(associated(domain%UG2SG%recv)) then + if(allocated(domain%UG2SG%recv)) then deallocate(domain%UG2SG%recv) - nullify(domain%UG2SG%recv) - nullify(domain%SG2UG%send) + !nullify(domain%UG2SG%recv) + !nullify(domain%SG2UG%send) end if end subroutine deallocate_unstruct_pass_type @@ -734,25 +734,25 @@ subroutine mpp_deallocate_domainUG(domain) ! null() + !domain%list => null() endif - if (associated(domain%io_domain)) then - if (associated(domain%io_domain%list)) then + if (allocated(domain%io_domain)) then + if (allocated(domain%io_domain%list)) then deallocate(domain%io_domain%list) - domain%io_domain%list => null() + !domain%io_domain%list => null() endif deallocate(domain%io_domain) - domain%io_domain => null() + !domain%io_domain => null() endif call deallocate_unstruct_pass_type(domain) - if (associated(domain%grid_index)) then + if (allocated(domain%grid_index)) then deallocate(domain%grid_index) - domain%grid_index => null() + !domain%grid_index => null() endif if (associated(domain%SG_domain)) then diff --git a/mpp/include/mpp_update_domains2D.fh b/mpp/include/mpp_update_domains2D.fh index 8f13cd235a..8b3c2376a7 100644 --- a/mpp/include/mpp_update_domains2D.fh +++ b/mpp/include/mpp_update_domains2D.fh @@ -61,8 +61,8 @@ integer, save :: isize=0, jsize=0, ke=0, l_size=0, list=0 integer, save :: pos, whalosz, ehalosz, shalosz, nhalosz MPP_TYPE_ :: d_type - type(overlapSpec), pointer :: update => NULL() - type(overlapSpec), pointer :: check => NULL() + type(overlapSpec), allocatable :: update + type(overlapSpec), allocatable :: check if(present(whalo)) then update_whalo = whalo @@ -151,12 +151,12 @@ if(do_update )then if( domain_update_is_needed(domain, update_whalo, update_ehalo, update_shalo, update_nhalo) )then if(debug_update_level .NE. NO_CHECK) then - check => search_check_overlap(domain, update_position) - if(ASSOCIATED(check) ) then + check = search_check_overlap(domain, update_position) + if(ALLOCATED(check) ) then call mpp_do_check(f_addrs(1:l_size,1:ntile), domain, check, d_type, ke, flags, name ) endif endif - update => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & + update = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & & update_position) !call mpp_do_update( f_addrs(1:l_size,1:ntile), domain, update, d_type, ke, & @@ -443,10 +443,10 @@ logical :: set_mismatch character(len=3) :: text MPP_TYPE_ :: d_type - type(overlapSpec), pointer :: updatex => NULL() - type(overlapSpec), pointer :: updatey => NULL() - type(overlapSpec), pointer :: checkx => NULL() - type(overlapSpec), pointer :: checky => NULL() + type(overlapSpec), allocatable :: updatex + type(overlapSpec), allocatable :: updatey + type(overlapSpec), allocatable :: checkx + type(overlapSpec), allocatable :: checky if(present(whalo)) then update_whalo = whalo @@ -562,9 +562,9 @@ end select if(debug_update_level .NE. NO_CHECK) then - checkx => search_check_overlap(domain, position_x) - checky => search_check_overlap(domain, position_y) - if(ASSOCIATED(checkx)) then + checkx = search_check_overlap(domain, position_x) + checky = search_check_overlap(domain, position_y) + if(ALLOCATED(checkx)) then if(exchange_uv) then call mpp_do_check(f_addrsx(1:l_size,1:ntile),f_addrsy(1:l_size,1:ntile), domain, & checky, checkx, d_type, ke, flags, name) @@ -574,9 +574,9 @@ end if endif endif - updatex => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & + updatex = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & & position_x) - updatey => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & + updatey = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & & position_y) if(exchange_uv) then call mpp_do_update(f_addrsx(1:l_size,1:ntile),f_addrsy(1:l_size,1:ntile), domain, updatey, updatex, & diff --git a/mpp/include/mpp_update_domains2D_ad.fh b/mpp/include/mpp_update_domains2D_ad.fh index 8a876fdba5..85af0415eb 100644 --- a/mpp/include/mpp_update_domains2D_ad.fh +++ b/mpp/include/mpp_update_domains2D_ad.fh @@ -61,7 +61,7 @@ integer, save :: isize=0, jsize=0, ke=0, l_size=0, list=0 integer, save :: pos, whalosz, ehalosz, shalosz, nhalosz MPP_TYPE_ :: d_type - type(overlapSpec), pointer :: update => NULL() + type(overlapSpec), allocatable :: update type(overlapSpec), pointer :: check => NULL() if(present(whalo)) then @@ -156,7 +156,7 @@ call mpp_do_check(f_addrs(1:l_size,1:ntile), domain, check, d_type, ke, flags, name ) endif endif - update => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & + update = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & & update_position) !call mpp_do_update( f_addrs(1:l_size,1:ntile), domain, update, d_type, ke, & @@ -269,8 +269,8 @@ logical :: set_mismatch character(len=3) :: text MPP_TYPE_ :: d_type - type(overlapSpec), pointer :: updatex => NULL() - type(overlapSpec), pointer :: updatey => NULL() + type(overlapSpec), allocatable :: updatex + type(overlapSpec), allocatable :: updatey type(overlapSpec), pointer :: checkx => NULL() type(overlapSpec), pointer :: checky => NULL() @@ -401,9 +401,9 @@ end if endif endif - updatex => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & + updatex = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & & position_x) - updatey => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & + updatey = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & & position_y) if(exchange_uv) then call mpp_do_update_ad(f_addrsx(1:l_size,1:ntile),f_addrsy(1:l_size,1:ntile), domain, updatey, updatex, & diff --git a/mpp/include/mpp_update_domains2D_nonblock.fh b/mpp/include/mpp_update_domains2D_nonblock.fh index fc8c9df306..c88ffc56e3 100644 --- a/mpp/include/mpp_update_domains2D_nonblock.fh +++ b/mpp/include/mpp_update_domains2D_nonblock.fh @@ -66,7 +66,7 @@ function MPP_START_UPDATE_DOMAINS_3D_( field, domain, flags, position, & character(len=128) :: text, field_name integer, save :: ke_list(MAX_DOMAIN_FIELDS, MAX_TILES)=0 integer(i8_kind), save :: f_addrs(MAX_DOMAIN_FIELDS, MAX_TILES)=-9999 - type(overlapSpec), pointer :: update => NULL() + type(overlapSpec), allocatable :: update MPP_TYPE_ :: d_type field_name = "unknown" @@ -225,7 +225,7 @@ function MPP_START_UPDATE_DOMAINS_3D_( field, domain, flags, position, & ke_max = maxval(ke_list(1:l_size,1:ntile)) if( domain_update_is_needed(domain, update_whalo, update_ehalo, update_shalo, update_nhalo) )then - update => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & + update = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & & update_position) call mpp_start_do_update(current_id, f_addrs(1:l_size,1:ntile), domain, update, d_type, & ke_max, ke_list(1:l_size,1:ntile), update_flags, reuse_id_update, field_name ) @@ -327,7 +327,7 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_3D_( id_update, field, domain, flags, pos integer :: update_whalo, update_ehalo, update_shalo, update_nhalo integer :: update_position, update_flags - type(overlapSpec), pointer :: update => NULL() + type(overlapSpec), allocatable :: update integer :: tile, max_ntile, ntile, n logical :: is_complete logical :: do_update @@ -438,7 +438,7 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_3D_( id_update, field, domain, flags, pos "mismatch of number of fields between mpp_start_update_domains and mpp_complete_update_domains") num_update = num_update - 1 if( domain_update_is_needed(domain, update_whalo, update_ehalo, update_shalo, update_nhalo) ) then - update => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & + update = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, & & update_position) ke_max = maxval(ke_list(1:l_size,1:ntile)) call mpp_complete_do_update(id_update, f_addrs(1:l_size,1:ntile), domain, update, d_type, & @@ -554,8 +554,8 @@ function MPP_START_UPDATE_DOMAINS_3D_V_( fieldx, fieldy, domain, flags, gridtype integer, save :: ke_list (MAX_DOMAIN_FIELDS, MAX_TILES)=0 integer(i8_kind), save :: f_addrsx(MAX_DOMAIN_FIELDS, MAX_TILES)=-9999 integer(i8_kind), save :: f_addrsy(MAX_DOMAIN_FIELDS, MAX_TILES)=-9999 - type(overlapSpec), pointer :: updatex => NULL() - type(overlapSpec), pointer :: updatey => NULL() + type(overlapSpec), allocatable :: updatex + type(overlapSpec), allocatable :: updatey MPP_TYPE_ :: d_type field_name = "unknown" @@ -744,8 +744,8 @@ function MPP_START_UPDATE_DOMAINS_3D_V_( fieldx, fieldy, domain, flags, gridtype case default call mpp_error(FATAL, "mpp_update_domains2D_nonblock.h: invalid value of grid_offset_type") end select - updatex => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, position_x) - updatey => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, position_y) + updatex = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, position_x) + updatey = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, position_y) ke_max = maxval(ke_list(1:l_size,1:ntile)) if(exchange_uv) then @@ -873,8 +873,8 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_3D_V_( id_update, fieldx, fieldy, domain, integer, save :: ke_list (MAX_DOMAIN_FIELDS, MAX_TILES)=0 integer(i8_kind), save :: f_addrsx(MAX_DOMAIN_FIELDS, MAX_TILES)=-9999 integer(i8_kind), save :: f_addrsy(MAX_DOMAIN_FIELDS, MAX_TILES)=-9999 - type(overlapSpec), pointer :: updatex => NULL() - type(overlapSpec), pointer :: updatey => NULL() + type(overlapSpec), allocatable :: updatex + type(overlapSpec), allocatable :: updatey MPP_TYPE_ :: d_type if(present(whalo)) then @@ -1011,8 +1011,8 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_3D_V_( id_update, fieldx, fieldy, domain, case default call mpp_error(FATAL, "mpp_update_domains2D.h: invalid value of grid_offset_type") end select - updatex => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, position_x) - updatey => search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, position_y) + updatex = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, position_x) + updatey = search_update_overlap(domain, update_whalo, update_ehalo, update_shalo, update_nhalo, position_y) ke_max = maxval(ke_list(1:l_size,1:ntile)) if(exchange_uv) then diff --git a/mpp/include/mpp_util.inc b/mpp/include/mpp_util.inc index ee3e3dcc59..e2b631a466 100644 --- a/mpp/include/mpp_util.inc +++ b/mpp/include/mpp_util.inc @@ -1082,7 +1082,7 @@ end function rarray_to_char peset_old(n)%start = peset(n)%start peset_old(n)%log2stride = peset(n)%log2stride - if( ASSOCIATED(peset(n)%list) ) then + if( ALLOCATED(peset(n)%list) ) then allocate(peset_old(n)%list(size(peset(n)%list(:))) ) peset_old(n)%list(:) = peset(n)%list(:) deallocate(peset(n)%list) @@ -1107,7 +1107,7 @@ end function rarray_to_char peset(n)%start = peset_old(n)%start peset(n)%log2stride = peset_old(n)%log2stride - if( ASSOCIATED(peset_old(n)%list) ) then + if( ALLOCATED(peset_old(n)%list) ) then allocate(peset(n)%list(size(peset_old(n)%list(:))) ) peset(n)%list(:) = peset_old(n)%list(:) deallocate(peset_old(n)%list) diff --git a/mpp/mpp.F90 b/mpp/mpp.F90 index 7d07e1937c..8ec833623b 100644 --- a/mpp/mpp.F90 +++ b/mpp/mpp.F90 @@ -230,7 +230,7 @@ module mpp_mod type :: communicator private character(len=32) :: name - integer, pointer :: list(:) =>NULL() + integer, allocatable :: list(:) integer :: count integer :: start, log2stride !< dummy variables when libMPI is defined. integer :: id, group !< MPI communicator and group id for this PE set. @@ -256,7 +256,7 @@ module mpp_mod integer :: peset_num logical :: sync_on_begin, detailed integer :: grain - type(event), pointer :: events(:) =>NULL() !> if needed, allocate to MAX_EVENT_TYPES + type(event), allocatable :: events(:) !> if needed, allocate to MAX_EVENT_TYPES logical :: is_on !> initialize to false. set true when calling mpp_clock_begin !! set false when calling mpp_clock_end end type clock diff --git a/mpp/mpp_domains.F90 b/mpp/mpp_domains.F90 index b2ccf3540f..aa2c2b2823 100644 --- a/mpp/mpp_domains.F90 +++ b/mpp/mpp_domains.F90 @@ -247,8 +247,8 @@ module mpp_domains_mod private integer :: count = 0 integer :: pe - integer, pointer :: i(:)=>NULL() - integer, pointer :: j(:)=>NULL() + integer, allocatable :: i(:) + integer, allocatable :: j(:) end type unstruct_overlap_type !> Private type @@ -256,8 +256,8 @@ module mpp_domains_mod type :: unstruct_pass_type private integer :: nsend, nrecv - type(unstruct_overlap_type), pointer :: recv(:)=>NULL() - type(unstruct_overlap_type), pointer :: send(:)=>NULL() + type(unstruct_overlap_type), allocatable :: recv(:) + type(unstruct_overlap_type), allocatable :: send(:) end type unstruct_pass_type !> Domain information for managing data on unstructured grids @@ -265,11 +265,11 @@ module mpp_domains_mod type :: domainUG private type(unstruct_axis_spec) :: compute, global !< axis specifications - type(unstruct_domain_spec), pointer :: list(:)=>NULL() !< - type(domainUG), pointer :: io_domain=>NULL() !< + type(unstruct_domain_spec), allocatable :: list(:) + type(domainUG), allocatable :: io_domain type(unstruct_pass_type) :: SG2UG type(unstruct_pass_type) :: UG2SG - integer, pointer :: grid_index(:) => NULL() !< index of grid on current pe + integer, allocatable :: grid_index(:) !< index of grid on current pe type(domain2d), pointer :: SG_domain => NULL() integer :: pe integer :: pos @@ -305,9 +305,9 @@ module mpp_domains_mod !> @ingroup mpp_domains_mod type :: domain2D_spec private - type(domain1D_spec), pointer :: x(:) => NULL() !< x-direction domain decomposition - type(domain1D_spec), pointer :: y(:) => NULL() !< y-direction domain decomposition - integer, pointer :: tile_id(:) => NULL() !< tile id of each tile + type(domain1D_spec), allocatable :: x(:) !< x-direction domain decomposition + type(domain1D_spec), allocatable :: y(:) !< y-direction domain decomposition + integer, allocatable :: tile_id(:) !< tile id of each tile integer :: pe !< PE to which this domain is assigned integer :: pos !< position of this PE within link list integer :: tile_root_pe !< root pe of tile. @@ -321,17 +321,17 @@ module mpp_domains_mod integer :: pe integer :: start_pos !< start position in the buffer integer :: totsize !< all message size - integer , pointer :: msgsize(:) => NULL() !< overlapping msgsize to be sent or received - integer, pointer :: tileMe(:) => NULL() !< my tile id for this overlap - integer, pointer :: tileNbr(:) => NULL() !< neighbor tile id for this overlap - integer, pointer :: is(:) => NULL() !< starting i-index - integer, pointer :: ie(:) => NULL() !< ending i-index - integer, pointer :: js(:) => NULL() !< starting j-index - integer, pointer :: je(:) => NULL() !< ending j-index - integer, pointer :: dir(:) => NULL() !< direction ( value 1,2,3,4 = E,S,W,N) - integer, pointer :: rotation(:) => NULL() !< rotation angle. - integer, pointer :: index(:) => NULL() !< for refinement - logical, pointer :: from_contact(:) => NULL() !< indicate if the overlap is computed from + integer , allocatable :: msgsize(:) !< overlapping msgsize to be sent or received + integer, allocatable :: tileMe(:) !< my tile id for this overlap + integer, allocatable :: tileNbr(:) !< neighbor tile id for this overlap + integer, allocatable :: is(:) !< starting i-index + integer, allocatable :: ie(:) !< ending i-index + integer, allocatable :: js(:) !< starting j-index + integer, allocatable :: je(:) !< ending j-index + integer, allocatable :: dir(:) !< direction ( value 1,2,3,4 = E,S,W,N) + integer, allocatable :: rotation(:) !< rotation angle. + integer, allocatable :: index(:) !< for refinement + logical, allocatable :: from_contact(:) !< indicate if the overlap is computed from !! define_contact_overlap end type overlap_type @@ -343,9 +343,9 @@ module mpp_domains_mod integer :: xbegin, xend, ybegin, yend integer :: nsend, nrecv integer :: sendsize, recvsize - type(overlap_type), pointer :: send(:) => NULL() - type(overlap_type), pointer :: recv(:) => NULL() - type(overlapSpec), pointer :: next => NULL() + type(overlap_type), allocatable :: send(:) + type(overlap_type), allocatable :: recv(:) + type(overlapSpec), allocatable :: next end type overlapSpec !> @brief Upper and lower x and y bounds for a tile @@ -381,30 +381,30 @@ module mpp_domains_mod integer :: tile_root_pe !< root pe of current tile. integer :: io_layout(2) !< io_layout, will be set through mpp_define_io_domain !! default = domain layout - integer, pointer :: pearray(:,:) => NULL() !< pe of each layout position - integer, pointer :: tile_id(:) => NULL() !< tile id of each tile on current processor - integer, pointer :: tile_id_all(:)=> NULL() !< tile id of all the tiles of domain - type(domain1D), pointer :: x(:) => NULL() !< x-direction domain decomposition - type(domain1D), pointer :: y(:) => NULL() !< y-direction domain decomposition - type(domain2D_spec),pointer :: list(:) => NULL() !< domain decomposition on pe list - type(tile_type), pointer :: tileList(:) => NULL() !< store tile information - type(overlapSpec), pointer :: check_C => NULL() !< send and recv information for boundary + integer, allocatable :: pearray(:,:) !< pe of each layout position + integer, allocatable :: tile_id(:) !< tile id of each tile on current processor + integer, allocatable :: tile_id_all(:) !< tile id of all the tiles of domain + type(domain1D), allocatable :: x(:) !< x-direction domain decomposition + type(domain1D), allocatable :: y(:) !< y-direction domain decomposition + type(domain2D_spec),allocatable :: list(:) !< domain decomposition on pe list + type(tile_type), allocatable :: tileList(:) !< store tile information + type(overlapSpec), allocatable :: check_C !< send and recv information for boundary !! consistency check of C-cell - type(overlapSpec), pointer :: check_E => NULL() !< send and recv information for boundary + type(overlapSpec), allocatable :: check_E !< send and recv information for boundary !! consistency check of E-cell - type(overlapSpec), pointer :: check_N => NULL() !< send and recv information for boundary + type(overlapSpec), allocatable :: check_N !< send and recv information for boundary !! consistency check of N-cell - type(overlapSpec), pointer :: bound_C => NULL() !< send information for getting boundary + type(overlapSpec), allocatable :: bound_C !< send information for getting boundary !! value for symmetry domain. - type(overlapSpec), pointer :: bound_E => NULL() !< send information for getting boundary + type(overlapSpec), allocatable :: bound_E !< send information for getting boundary !! value for symmetry domain. - type(overlapSpec), pointer :: bound_N => NULL() !< send information for getting boundary + type(overlapSpec), allocatable :: bound_N !< send information for getting boundary !! value for symmetry domain. - type(overlapSpec), pointer :: update_T => NULL() !< send and recv information for halo update of T-cell. - type(overlapSpec), pointer :: update_E => NULL() !< send and recv information for halo update of E-cell. - type(overlapSpec), pointer :: update_C => NULL() !< send and recv information for halo update of C-cell. - type(overlapSpec), pointer :: update_N => NULL() !< send and recv information for halo update of N-cell. - type(domain2d), pointer :: io_domain => NULL() !< domain for IO, will be set through calling + type(overlapSpec), allocatable :: update_T !< send and recv information for halo update of T-cell. + type(overlapSpec), allocatable :: update_E !< send and recv information for halo update of E-cell. + type(overlapSpec), allocatable :: update_C !< send and recv information for halo update of C-cell. + type(overlapSpec), allocatable :: update_N !< send and recv information for halo update of N-cell. + type(domain2d), allocatable :: io_domain !< domain for IO, will be set through calling !! mpp_set_io_domain ( this will be changed). END TYPE domain2D @@ -414,13 +414,13 @@ module mpp_domains_mod type, private :: contact_type private integer :: ncontact !< number of neighbor tile. - integer, pointer :: tile(:) =>NULL() !< neighbor tile - integer, pointer :: align1(:)=>NULL(), align2(:)=>NULL() !< alignment of me and neighbor - real, pointer :: refine1(:)=>NULL(), refine2(:)=>NULL() ! - integer, pointer :: is1(:)=>NULL(), ie1(:)=>NULL() !< i-index of current tile repsenting contact - integer, pointer :: js1(:)=>NULL(), je1(:)=>NULL() !< j-index of current tile repsenting contact - integer, pointer :: is2(:)=>NULL(), ie2(:)=>NULL() !< i-index of neighbor tile repsenting contact - integer, pointer :: js2(:)=>NULL(), je2(:)=>NULL() !< j-index of neighbor tile repsenting contact + integer, allocatable :: tile(:) !< neighbor tile + integer, allocatable :: align1(:), align2(:) !< alignment of me and neighbor + real, allocatable :: refine1(:), refine2(:) ! + integer, allocatable :: is1(:), ie1(:) !< i-index of current tile repsenting contact + integer, allocatable :: js1(:), je1(:) !< j-index of current tile repsenting contact + integer, allocatable :: is2(:), ie2(:) !< i-index of neighbor tile repsenting contact + integer, allocatable :: js2(:), je2(:) !< j-index of neighbor tile repsenting contact end type contact_type !> index bounds for use in @ref nestSpec @@ -441,9 +441,9 @@ module mpp_domains_mod type(index_type) :: west, east, south, north, center integer :: nsend, nrecv integer :: extra_halo - type(overlap_type), pointer :: send(:) => NULL() - type(overlap_type), pointer :: recv(:) => NULL() - type(nestSpec), pointer :: next => NULL() + type(overlap_type), allocatable :: send(:) + type(overlap_type), allocatable :: recv(:) + type(nestSpec), allocatable :: next end type nestSpec @@ -452,12 +452,12 @@ module mpp_domains_mod type :: nest_domain_type character(len=NAME_LENGTH) :: name integer :: num_level - integer, pointer :: nest_level(:) !< Added for moving nest functionality - type(nest_level_type), pointer :: nest(:) => NULL() + integer, allocatable :: nest_level(:) !< Added for moving nest functionality + type(nest_level_type), allocatable :: nest(:) integer :: num_nest - integer, pointer :: tile_fine(:), tile_coarse(:) - integer, pointer :: istart_fine(:), iend_fine(:), jstart_fine(:), jend_fine(:) - integer, pointer :: istart_coarse(:), iend_coarse(:), jstart_coarse(:), jend_coarse(:) + integer, allocatable :: tile_fine(:), tile_coarse(:) + integer, allocatable :: istart_fine(:), iend_fine(:), jstart_fine(:), jend_fine(:) + integer, allocatable :: istart_coarse(:), iend_coarse(:), jstart_coarse(:), jend_coarse(:) end type nest_domain_type !> Private type to hold data for each level of nesting @@ -468,25 +468,25 @@ module mpp_domains_mod logical :: is_fine, is_coarse integer :: num_nest integer :: my_num_nest - integer, pointer :: my_nest_id(:) - integer, pointer :: tile_fine(:), tile_coarse(:) - integer, pointer :: istart_fine(:), iend_fine(:), jstart_fine(:), jend_fine(:) - integer, pointer :: istart_coarse(:), iend_coarse(:), jstart_coarse(:), jend_coarse(:) + integer, allocatable :: my_nest_id(:) + integer, allocatable :: tile_fine(:), tile_coarse(:) + integer, allocatable :: istart_fine(:), iend_fine(:), jstart_fine(:), jend_fine(:) + integer, allocatable :: istart_coarse(:), iend_coarse(:), jstart_coarse(:), jend_coarse(:) integer :: x_refine, y_refine logical :: is_fine_pe, is_coarse_pe - integer, pointer :: pelist(:) => NULL() - integer, pointer :: pelist_fine(:) => NULL() - integer, pointer :: pelist_coarse(:) => NULL() - type(nestSpec), pointer :: C2F_T => NULL() - type(nestSpec), pointer :: C2F_C => NULL() - type(nestSpec), pointer :: C2F_E => NULL() - type(nestSpec), pointer :: C2F_N => NULL() - type(nestSpec), pointer :: F2C_T => NULL() - type(nestSpec), pointer :: F2C_C => NULL() - type(nestSpec), pointer :: F2C_E => NULL() - type(nestSpec), pointer :: F2C_N => NULL() - type(domain2d), pointer :: domain_fine => NULL() - type(domain2d), pointer :: domain_coarse => NULL() + integer, allocatable :: pelist(:) + integer, allocatable :: pelist_fine(:) + integer, allocatable :: pelist_coarse(:) + type(nestSpec), allocatable :: C2F_T + type(nestSpec), allocatable :: C2F_C + type(nestSpec), allocatable :: C2F_E + type(nestSpec), allocatable :: C2F_N + type(nestSpec), allocatable :: F2C_T + type(nestSpec), allocatable :: F2C_C + type(nestSpec), allocatable :: F2C_E + type(nestSpec), allocatable :: F2C_N + type(domain2d), allocatable :: domain_fine + type(domain2d), allocatable :: domain_coarse end type nest_level_type @@ -632,7 +632,7 @@ module mpp_domains_mod type(domain_axis_spec) :: global !< index limits for global domain type(domain_axis_spec) :: memory !< index limits for memory domain logical :: cyclic !< true if domain is cyclic - type(domain1D), pointer :: list(:) =>NULL() !< list of each pe's domains + type(domain1D), allocatable :: list(:) !< list of each pe's domains integer :: pe !