From 2fa6cef507a4674fed81bc50b074a513677a3bc2 Mon Sep 17 00:00:00 2001 From: Ganga P Purja Pun Date: Fri, 28 Apr 2023 14:58:01 -0400 Subject: [PATCH 01/10] Replaces pointers which are allocated with allocatables --- exchange/xgrid.F90 | 138 ++++++++++++++++++++++----------------------- 1 file changed, 69 insertions(+), 69 deletions(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 54a32ec8e2..c5803f07fb 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -287,17 +287,17 @@ module xgrid_mod !> Type to hold pointers for grid boxes !> @ingroup xgrid_mod type grid_box_type - real(r8_kind), dimension(:,:), pointer :: dx => NULL() - real(r8_kind), dimension(:,:), pointer :: dy => NULL() - real(r8_kind), dimension(:,:), pointer :: area => NULL() - real(r8_kind), dimension(:), pointer :: edge_w => NULL() - real(r8_kind), dimension(:), pointer :: edge_e => NULL() - real(r8_kind), dimension(:), pointer :: edge_s => NULL() - real(r8_kind), dimension(:), pointer :: edge_n => NULL() - real(r8_kind), dimension(:,:,:), pointer :: en1 => NULL() - real(r8_kind), dimension(:,:,:), pointer :: en2 => NULL() - real(r8_kind), dimension(:,:,:), pointer :: vlon => NULL() - real(r8_kind), dimension(:,:,:), pointer :: vlat => NULL() + real(r8_kind), dimension(:,:), allocatable :: dx + real(r8_kind), dimension(:,:), allocatable :: dy + real(r8_kind), dimension(:,:), allocatable :: area + real(r8_kind), dimension(:), allocatable :: edge_w + real(r8_kind), dimension(:), allocatable :: edge_e + real(r8_kind), dimension(:), allocatable :: edge_s + real(r8_kind), dimension(:), allocatable :: edge_n + real(r8_kind), dimension(:,:,:), allocatable :: en1 + real(r8_kind), dimension(:,:,:), allocatable :: en2 + real(r8_kind), dimension(:,:,:), allocatable :: vlon + real(r8_kind), dimension(:,:,:), allocatable :: vlat end type grid_box_type !> Private type to hold all data needed from given grid for an exchange grid @@ -307,15 +307,15 @@ module xgrid_mod integer :: npes !< number of processor on this grid. logical :: on_this_pe !< indicate the domain is defined on this pe integer :: root_pe !< indicate the root pe of the domain - integer, pointer, dimension(:) :: pelist !< pelist of the domain + integer, allocatable, dimension(:) :: pelist !< pelist of the domain integer :: ntile !< number of tiles in mosaic integer :: ni !< max of global size of all the tiles integer :: nj !< max of global size of all the tiles - integer, pointer, dimension(:) :: tile =>NULL() !< tile id ( pe index ) - integer, pointer, dimension(:) :: is =>NULL() !< domain - i-range (pe index) - integer, pointer, dimension(:) :: ie =>NULL() !< domain - i-range (pe index) - integer, pointer, dimension(:) :: js =>NULL() !< domain - j-range (pe index) - integer, pointer, dimension(:) :: je =>NULL() !< domain - j-range (pe index) + integer, allocatable, dimension(:) :: tile !< tile id ( pe index ) + integer, allocatable, dimension(:) :: is !< domain - i-range (pe index) + integer, allocatable, dimension(:) :: ie !< domain - i-range (pe index) + integer, allocatable, dimension(:) :: js !< domain - j-range (pe index) + integer, allocatable, dimension(:) :: je !< domain - j-range (pe index) integer, pointer :: is_me =>NULL() !< my domain - i-range integer, pointer :: ie_me =>NULL() !< my domain - i-range integer, pointer :: js_me =>NULL() !< my domain - j-range @@ -332,21 +332,21 @@ module xgrid_mod integer :: im !< global domain range integer :: jm !< global domain range integer :: km !< global domain range - real(r8_kind), pointer, dimension(:) :: lon =>NULL() !< center of global grids - real(r8_kind), pointer, dimension(:) :: lat =>NULL() !< center of global grids - real(r8_kind), pointer, dimension(:,:) :: geolon=>NULL() !< geographical grid center - real(r8_kind), pointer, dimension(:,:) :: geolat=>NULL() !< geographical grid center - real(r8_kind), pointer, dimension(:,:,:) :: frac_area =>NULL() !< partition fractions - real(r8_kind), pointer, dimension(:,:) :: area =>NULL() !< cell area - real(r8_kind), pointer, dimension(:,:) :: area_inv =>NULL() !< 1 / area for normalization + real(r8_kind), allocatable, dimension(:) :: lon !< center of global grids + real(r8_kind), allocatable, dimension(:) :: lat !< center of global grids + real(r8_kind), allocatable, dimension(:,:) :: geolon !< geographical grid center + real(r8_kind), allocatable, dimension(:,:) :: geolat !< geographical grid center + real(r8_kind), allocatable, dimension(:,:,:) :: frac_area !< partition fractions + real(r8_kind), allocatable, dimension(:,:) :: area !< cell area + real(r8_kind), allocatable, dimension(:,:) :: area_inv !< 1 / area for normalization integer :: first !< xgrid index range integer :: last !< xgrid index range integer :: first_get !< xgrid index range for get_2_from_xgrid integer :: last_get !< xgrid index range for get_2_from_xgrid integer :: size !< # xcell patterns - type(xcell_type), pointer :: x(:) =>NULL() !< xcell patterns + type(xcell_type), allocatable :: x(:) !< xcell patterns integer :: size_repro !< # side 1 patterns for repro - type(xcell_type), pointer :: x_repro(:) =>NULL() !< side 1 patterns for repro + type(xcell_type), allocatable :: x_repro(:) !< side 1 patterns for repro type(Domain2d) :: domain !< used for conservation checks type(Domain2d) :: domain_with_halo !< used for second order remapping logical :: is_latlon !< indicate if the grid is lat-lon grid or not. @@ -356,10 +356,10 @@ module xgrid_mod integer :: nxl_me integer, pointer :: ls_me =>NULL() !< unstruct domain integer, pointer :: le_me =>NULL() !< unstruct domain - integer, pointer, dimension(:) :: ls =>NULL(), le =>NULL() + integer, allocatable, dimension(:) :: ls, le integer, pointer :: gs_me =>NULL(), ge_me =>NULL() - integer, pointer, dimension(:) :: gs =>NULL(), ge =>NULL() - integer, pointer, dimension(:) :: l_index =>NULL() + integer, allocatable, dimension(:) :: gs, ge + integer, allocatable, dimension(:) :: l_index type(DomainUG) :: ug_domain end type grid_type @@ -404,9 +404,9 @@ module xgrid_mod type comm_type integer :: nsend, nrecv integer :: sendsize, recvsize - integer, pointer, dimension(:) :: unpack_ind=>NULL() - type(overlap_type), pointer, dimension(:) :: send=>NULL() - type(overlap_type), pointer, dimension(:) :: recv=>NULL() + integer, allocatable, dimension(:) :: unpack_ind + type(overlap_type), allocatable, dimension(:) :: send + type(overlap_type), allocatable, dimension(:) :: recv end type comm_type !> @brief Type for an exchange grid, holds pointers to included grids and any necessary data. @@ -417,38 +417,38 @@ module xgrid_mod integer :: size_put1 !< # of exchange grid cells for put_1_to_xgrid integer :: size_get2 !< # of exchange grid cells for get_2_to_xgrid integer :: me, npes, root_pe - logical, pointer, dimension(:) :: your1my2 =>NULL()!< true if side 1 domain on + logical, allocatable, dimension(:) :: your1my2 !< true if side 1 domain on !! indexed pe overlaps side 2 !! domain on this pe - logical, pointer, dimension(:) :: your2my1 =>NULL() !< true if a side 2 domain on + logical, allocatable, dimension(:) :: your2my1 !< true if a side 2 domain on !! indexed pe overlaps side 1 !! domain on this pe - integer, pointer, dimension(:) :: your2my1_size=>NULL() !< number of exchange grid of + integer, allocatable, dimension(:) :: your2my1_size !< number of exchange grid of !! a side 2 domain on !! indexed pe overlaps side 1 !! domain on this pe - type (grid_type), pointer, dimension(:) :: grids =>NULL() !< 1st grid is side 1; + type (grid_type), allocatable, dimension(:) :: grids !< 1st grid is side 1; !! rest on side 2 ! ! Description of the individual exchange grid cells (index is cell #) ! - type(x1_type), pointer, dimension(:) :: x1 =>NULL() !< side 1 info - type(x1_type), pointer, dimension(:) :: x1_put =>NULL() !< side 1 info - type(x2_type), pointer, dimension(:) :: x2 =>NULL() !< side 2 info - type(x2_type), pointer, dimension(:) :: x2_get =>NULL() !< side 2 info + type(x1_type), allocatable, dimension(:) :: x1 !< side 1 info + type(x1_type), allocatable, dimension(:) :: x1_put !< side 1 info + type(x2_type), allocatable, dimension(:) :: x2 !< side 2 info + type(x2_type), allocatable, dimension(:) :: x2_get !< side 2 info - integer, pointer, dimension(:) :: send_count_repro =>NULL() - integer, pointer, dimension(:) :: recv_count_repro =>NULL() + integer, allocatable, dimension(:) :: send_count_repro + integer, allocatable, dimension(:) :: recv_count_repro integer :: send_count_repro_tot !< sum(send_count_repro) integer :: recv_count_repro_tot !< sum(recv_count_repro) integer :: version !< version of xgrids. version=VERSION! is for grid_spec file !! and version=VERSION2 is for mosaic grid. - integer, pointer, dimension(:) :: ind_get1 =>NULL() !< indx for side1 get and side2 put. - integer, pointer, dimension(:) :: ind_put1 =>NULL() !< indx for side1 put and side 2get. - type(comm_type), pointer :: put1 =>NULL() !< for put_1_to_xgrid - type(comm_type), pointer :: get1 =>NULL() !< for get_1_from_xgrid - type(comm_type), pointer :: get1_repro =>NULL()!< for get_1_from_xgrid_repro + integer, allocatable, dimension(:) :: ind_get1 !< indx for side1 get and side2 put. + integer, allocatable, dimension(:) :: ind_put1 !< indx for side1 put and side 2get. + type(comm_type), allocatable :: put1 !< for put_1_to_xgrid + type(comm_type), allocatable :: get1 !< for get_1_from_xgrid + type(comm_type), allocatable :: get1_repro !< for get_1_from_xgrid_repro end type xmap_type !> @addtogroup stock_constants_mod @@ -599,18 +599,18 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u integer, intent(in) :: tile1, tile2 logical, intent(in) :: use_higher_order - integer, pointer, dimension(:) :: i1=>NULL(), j1=>NULL() - integer, pointer, dimension(:) :: i2=>NULL(), j2=>NULL() - real(r8_kind), pointer, dimension(:) :: di=>NULL(), dj=>NULL() - real(r8_kind), pointer, dimension(:) :: area =>NULL() - integer, pointer, dimension(:) :: i1_tmp=>NULL(), j1_tmp=>NULL() - integer, pointer, dimension(:) :: i2_tmp=>NULL(), j2_tmp=>NULL() - real(r8_kind), pointer, dimension(:) :: di_tmp=>NULL(), dj_tmp=>NULL() - real(r8_kind), pointer, dimension(:) :: area_tmp =>NULL() - integer, pointer, dimension(:) :: i1_side1=>NULL(), j1_side1=>NULL() - integer, pointer, dimension(:) :: i2_side1=>NULL(), j2_side1=>NULL() - real(r8_kind), pointer, dimension(:) :: di_side1=>NULL(), dj_side1=>NULL() - real(r8_kind), pointer, dimension(:) :: area_side1 =>NULL() + integer, allocatable, dimension(:) :: i1, j1 + integer, allocatable, dimension(:) :: i2, j2 + real(r8_kind), allocatable, dimension(:) :: di, dj + real(r8_kind), allocatable, dimension(:) :: area + integer, allocatable, dimension(:) :: i1_tmp, j1_tmp + integer, allocatable, dimension(:) :: i2_tmp, j2_tmp + real(r8_kind), allocatable, dimension(:) :: di_tmp, dj_tmp + real(r8_kind), allocatable, dimension(:) :: area_tmp + integer, allocatable, dimension(:) :: i1_side1, j1_side1 + integer, allocatable, dimension(:) :: i2_side1, j2_side1 + real(r8_kind), allocatable, dimension(:) :: di_side1, dj_side1 + real(r8_kind), allocatable, dimension(:) :: area_side1 real(r8_kind), allocatable, dimension(:,:) :: tmp real(r8_kind), allocatable, dimension(:) :: send_buffer, recv_buffer @@ -637,7 +637,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u integer, dimension(2*xmap%npes) :: ibuf1, ibuf2 integer, dimension(0:xmap%npes-1) :: pos_x, y2m1_size integer, allocatable, dimension(:) :: y2m1_pe - integer, pointer, save :: iarray(:), jarray(:) + integer, allocatable, save :: iarray(:), jarray(:) integer, allocatable, save :: pos_s(:) integer, pointer, dimension(:) :: iarray2(:)=>NULL(), jarray2(:)=>NULL() logical :: last_grid @@ -1243,7 +1243,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u if(ll_repro > 0) then ! extend data allocate(x_local(ll_repro)) x_local = grid%x_repro - if(ASSOCIATED(grid%x_repro)) deallocate(grid%x_repro) + if(allocated(grid%x_repro)) deallocate(grid%x_repro) allocate( grid%x_repro(grid%size_repro ) ) grid%x_repro(1:ll_repro) = x_local deallocate(x_local) @@ -1758,10 +1758,10 @@ subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_ grid%js_me-grid%jsd_me .NE. 1 .or. grid%jed_me-grid%je_me .NE. 1 ) & & call error_mesg('xgrid_mod', 'for non-latlon grid (cubic grid), '//& & 'the halo size should be 1 in all four direction', FATAL) - if(.NOT.( ASSOCIATED(atm_grid%dx) .AND. ASSOCIATED(atm_grid%dy) .AND. ASSOCIATED(atm_grid%edge_w) .AND. & - ASSOCIATED(atm_grid%edge_e) .AND. ASSOCIATED(atm_grid%edge_s) .AND.ASSOCIATED(atm_grid%edge_n).AND.& - ASSOCIATED(atm_grid%en1) .AND. ASSOCIATED(atm_grid%en2) .AND. ASSOCIATED(atm_grid%vlon) .AND. & - ASSOCIATED(atm_grid%vlat) ) ) call error_mesg( 'xgrid_mod', & + if(.NOT.( allocated(atm_grid%dx) .AND. allocated(atm_grid%dy) .AND. allocated(atm_grid%edge_w) .AND. & + allocated(atm_grid%edge_e) .AND. allocated(atm_grid%edge_s) .AND.allocated(atm_grid%edge_n).AND.& + allocated(atm_grid%en1) .AND. allocated(atm_grid%en2) .AND. allocated(atm_grid%vlon) .AND. & + allocated(atm_grid%vlat) ) ) call error_mesg( 'xgrid_mod', & 'for non-latlon grid (cubic grid), all the fields in atm_grid data type should be allocated', FATAL) nxc = grid%ie_me - grid%is_me + 1 nyc = grid%je_me - grid%js_me + 1 @@ -4395,7 +4395,7 @@ subroutine stock_move_3d(from, to, grid_index, data, xmap, & return endif - if(.not. associated(xmap%grids) ) then + if(.not. allocated(xmap%grids) ) then ier = 2 return endif @@ -4449,7 +4449,7 @@ subroutine stock_move_2d(from, to, grid_index, data, xmap, & ier = 0 - if(.not. associated(xmap%grids) ) then + if(.not. allocated(xmap%grids) ) then ier = 3 return endif @@ -4520,7 +4520,7 @@ subroutine stock_move_ug_3d(from, to, grid_index, data, xmap, & return endif - if(.not. associated(xmap%grids) ) then + if(.not. allocated(xmap%grids) ) then ier = 2 return endif @@ -4566,7 +4566,7 @@ subroutine stock_integrate_2d(data, xmap, delta_t, radius, res, ier) ier = 0 res = 0.0 - if(.not. associated(xmap%grids) ) then + if(.not. allocated(xmap%grids) ) then ier = 6 return endif From 82f2cdf540b19fa235d9756e203743f7ae0972d2 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Fri, 28 Apr 2023 16:08:56 -0400 Subject: [PATCH 02/10] Update xgrid.F90 --- exchange/xgrid.F90 | 57 +++++++++++++++++++++++----------------------- 1 file changed, 28 insertions(+), 29 deletions(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index c5803f07fb..58730782bc 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -592,7 +592,7 @@ end subroutine xgrid_init !####################################################################### subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, use_higher_order) -type(xmap_type), intent(inout) :: xmap +type(xmap_type), intent(inout), target :: xmap type(grid_type), intent(inout) :: grid character(len=*), intent(in) :: grid_file character(len=3), intent(in) :: grid1_id, grid_id @@ -637,7 +637,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u integer, dimension(2*xmap%npes) :: ibuf1, ibuf2 integer, dimension(0:xmap%npes-1) :: pos_x, y2m1_size integer, allocatable, dimension(:) :: y2m1_pe - integer, allocatable, save :: iarray(:), jarray(:) + integer, allocatable, save, target :: iarray(:), jarray(:) integer, allocatable, save :: pos_s(:) integer, pointer, dimension(:) :: iarray2(:)=>NULL(), jarray2(:)=>NULL() logical :: last_grid @@ -1039,12 +1039,12 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u else nxgrid1 = nxgrid nxgrid2 = nxgrid - i1_side1 => i1; j1_side1 => j1 - i2_side1 => i2; j2_side1 => j2 - area_side1 => area + i1_side1 = i1; j1_side1 = j1 + i2_side1 = i2; j2_side1 = j2 + area_side1 = area if(use_higher_order) then - di_side1 => di - dj_side1 => dj + di_side1 = di + dj_side1 = dj endif endif @@ -1082,7 +1082,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u if(size_prev > 0) then ! need to extend data allocate(x_local(size_prev)) x_local = grid%x - if(ASSOCIATED(grid%x)) deallocate(grid%x) + if(allocated(grid%x)) deallocate(grid%x) allocate( grid%x( grid%size ) ) grid%x(1:size_prev) = x_local deallocate(x_local) @@ -1139,7 +1139,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u size_repro = 0 if(grid1%tile_me == tile1) then - if(associated(iarray)) then + if(allocated(iarray)) then nxgrid1_old = size(iarray(:)) else nxgrid1_old = 0 @@ -1288,7 +1288,6 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u if(use_higher_order) deallocate(di_side1, dj_side1) endif - i1=>NULL(); j1=>NULL(); i2=>NULL(); j2=>NULL() call mpp_clock_end(id_load_xgrid5) @@ -1508,7 +1507,7 @@ end subroutine get_ocean_model_area_elements !> @brief Sets up exchange grid connectivity using grid specification file and !! processor domain decomposition. subroutine setup_xmap(xmap, grid_ids, grid_domains, grid_file, atm_grid, lnd_ug_domain) - type (xmap_type), intent(inout) :: xmap + type (xmap_type), target, intent(inout) :: xmap character(len=3), dimension(:), intent(in ) :: grid_ids type(Domain2d), dimension(:), intent(in ) :: grid_domains character(len=*), intent(in ) :: grid_file @@ -2257,7 +2256,7 @@ end subroutine set_comm_get1_repro !####################################################################### subroutine set_comm_get1(xmap) - type (xmap_type), intent(inout) :: xmap + type (xmap_type), intent(inout), target :: xmap type (grid_type), pointer, save :: grid1 =>NULL() integer, allocatable :: send_size(:) integer, allocatable :: recv_size(:) @@ -2556,7 +2555,7 @@ end subroutine set_comm_get1 !############################################################################### subroutine set_comm_put1(xmap) - type (xmap_type), intent(inout) :: xmap + type (xmap_type), intent(inout), target :: xmap type (grid_type), pointer, save :: grid1 =>NULL() integer, allocatable :: send_size(:) integer, allocatable :: recv_size(:) @@ -2578,9 +2577,9 @@ subroutine set_comm_put1(xmap) comm%nrecv = xmap%get1%nsend comm%sendsize = xmap%get1%recvsize comm%recvsize = xmap%get1%sendsize - comm%send => xmap%get1%recv - comm%recv => xmap%get1%send - xmap%ind_put1 => xmap%ind_get1 + comm%send = xmap%get1%recv + comm%recv = xmap%get1%send + xmap%ind_put1 = xmap%ind_get1 return endif @@ -3056,7 +3055,7 @@ end subroutine regen subroutine set_frac_area_sg(f, grid_id, xmap) real(r8_kind), dimension(:,:,:), intent(in ) :: f !< fraction area to be set character(len=3), intent(in ) :: grid_id !< 3 character grid ID -type (xmap_type), intent(inout) :: xmap !< exchange grid with given grid ID +type (xmap_type), target, intent(inout) :: xmap !< exchange grid with given grid ID integer :: g type(grid_type), pointer, save :: grid =>NULL() @@ -3088,7 +3087,7 @@ end subroutine set_frac_area_sg subroutine set_frac_area_ug(f, grid_id, xmap) real(r8_kind), dimension(:,:), intent(in ) :: f !< fractional area to set character(len=3), intent(in ) :: grid_id !< 3 character grid ID -type (xmap_type), intent(inout) :: xmap !< exchange grid with given grid ID +type (xmap_type), target, intent(inout) :: xmap !< exchange grid with given grid ID integer :: g type(grid_type), pointer, save :: grid =>NULL() @@ -3433,7 +3432,7 @@ end subroutine get_2_from_xgrid subroutine put_1_to_xgrid_order_1(d_addrs, x_addrs, xmap, isize, jsize, xsize, lsize) integer(i8_kind), dimension(:), intent(in) :: d_addrs integer(i8_kind), dimension(:), intent(in) :: x_addrs - type (xmap_type), intent(inout) :: xmap + type (xmap_type), target, intent(inout) :: xmap integer, intent(in) :: isize, jsize, xsize, lsize integer :: i, j, p, buffer_pos, msgsize @@ -3522,7 +3521,7 @@ end subroutine put_1_to_xgrid_order_1 subroutine put_1_to_xgrid_order_2(d_addrs, x_addrs, xmap, isize, jsize, xsize, lsize) integer(i8_kind), dimension(:), intent(in) :: d_addrs integer(i8_kind), dimension(:), intent(in) :: x_addrs - type (xmap_type), intent(inout) :: xmap + type (xmap_type), target, intent(inout) :: xmap integer, intent(in) :: isize, jsize, xsize, lsize !: NOTE: halo size is assumed to be 1 in setup_xmap @@ -3760,7 +3759,7 @@ end subroutine put_1_to_xgrid_order_2 subroutine get_1_from_xgrid(d_addrs, x_addrs, xmap, isize, jsize, xsize, lsize) integer(i8_kind), dimension(:), intent(in) :: d_addrs integer(i8_kind), dimension(:), intent(in) :: x_addrs - type (xmap_type), intent(inout) :: xmap + type (xmap_type), target, intent(inout) :: xmap integer, intent(in) :: isize, jsize, xsize, lsize real(r8_kind), dimension(xmap%size), target :: dg(xmap%size, lsize) @@ -3892,7 +3891,7 @@ end subroutine get_1_from_xgrid subroutine get_1_from_xgrid_repro(d_addrs, x_addrs, xmap, xsize, lsize) integer(i8_kind), dimension(:), intent(in) :: d_addrs integer(i8_kind), dimension(:), intent(in) :: x_addrs - type (xmap_type), intent(inout) :: xmap + type (xmap_type), target, intent(inout) :: xmap integer, intent(in) :: xsize, lsize integer :: g, i, j, k, p, l, n, l2, l3 @@ -3994,7 +3993,7 @@ end subroutine get_1_from_xgrid_repro function conservation_check_side1(d, grid_id, xmap,remap_method) ! this one for 1->2->1 real(r8_kind), dimension(:,:), intent(in ) :: d !< model data to check character(len=3), intent(in ) :: grid_id !< 3 character grid id -type (xmap_type), intent(inout) :: xmap !< exchange grid +type (xmap_type), target, intent(inout) :: xmap !< exchange grid real(r8_kind), dimension(3) :: conservation_check_side1 integer, intent(in), optional :: remap_method @@ -4041,7 +4040,7 @@ end function conservation_check_side1 function conservation_check_side2(d, grid_id, xmap,remap_method) ! this one for 2->1->2 real(r8_kind), dimension(:,:,:), intent(in ) :: d !< model data to check character(len=3), intent(in ) :: grid_id !< 3 character grid ID -type (xmap_type), intent(inout) :: xmap !< exchange grid +type (xmap_type), target, intent(inout) :: xmap !< exchange grid real(r8_kind), dimension(3) :: conservation_check_side2 integer, intent(in), optional :: remap_method @@ -4097,7 +4096,7 @@ end function conservation_check_side2 function conservation_check_ug_side1(d, grid_id, xmap,remap_method) ! this one for 1->2->1 real(r8_kind), dimension(:,:), intent(in ) :: d !< model data to check character(len=3), intent(in ) :: grid_id !< 3 character grid ID -type (xmap_type), intent(inout) :: xmap !< exchange grid +type (xmap_type), target, intent(inout) :: xmap !< exchange grid real(r8_kind), dimension(3) :: conservation_check_ug_side1 integer, intent(in), optional :: remap_method @@ -4170,7 +4169,7 @@ end function conservation_check_ug_side1 function conservation_check_ug_side2(d, grid_id, xmap,remap_method) ! this one for 2->1->2 real(r8_kind), dimension(:,:,:), intent(in ) :: d !< model data to check character(len=3), intent(in ) :: grid_id !< 3 character grid ID -type (xmap_type), intent(inout) :: xmap !< exchange grid +type (xmap_type), target, intent(inout) :: xmap !< exchange grid real(r8_kind), dimension(3) :: conservation_check_ug_side2 integer, intent(in), optional :: remap_method @@ -4948,7 +4947,7 @@ end subroutine get_side2_from_xgrid_ug subroutine put_1_to_xgrid_ug_order_1(d_addrs, x_addrs, xmap, dsize, xsize, lsize) integer(i8_kind), dimension(:), intent(in) :: d_addrs integer(i8_kind), dimension(:), intent(in) :: x_addrs - type (xmap_type), intent(inout) :: xmap + type (xmap_type), target, intent(inout) :: xmap integer, intent(in) :: dsize, xsize, lsize integer :: i, p, buffer_pos, msgsize @@ -5053,7 +5052,7 @@ end subroutine put_2_to_xgrid_ug subroutine get_1_from_xgrid_ug(d_addrs, x_addrs, xmap, isize, xsize, lsize) integer(i8_kind), dimension(:), intent(in) :: d_addrs integer(i8_kind), dimension(:), intent(in) :: x_addrs - type (xmap_type), intent(inout) :: xmap + type (xmap_type), target, intent(inout) :: xmap integer, intent(in) :: isize, xsize, lsize real(r8_kind), dimension(xmap%size), target :: dg(xmap%size, lsize) @@ -5183,7 +5182,7 @@ end subroutine get_1_from_xgrid_ug subroutine get_1_from_xgrid_ug_repro(d_addrs, x_addrs, xmap, xsize, lsize) integer(i8_kind), dimension(:), intent(in) :: d_addrs integer(i8_kind), dimension(:), intent(in) :: x_addrs - type (xmap_type), intent(inout) :: xmap + type (xmap_type), target, intent(inout) :: xmap integer, intent(in) :: xsize, lsize integer :: g, i, j, k, p, l, n, l2, l3 From 39dd0697cad794ba1d84f1336af92a174323a0d6 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Fri, 28 Apr 2023 16:13:26 -0400 Subject: [PATCH 03/10] Update xgrid.F90 --- exchange/xgrid.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 58730782bc..0bfa75bb88 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -2151,7 +2151,7 @@ end function get_nest_contact_fms2_io !####################################################################### subroutine set_comm_get1_repro(xmap) - type (xmap_type), intent(inout) :: xmap + type (xmap_type), intent(inout), target :: xmap integer, dimension(xmap%npes) :: pe_ind, cnt integer, dimension(0:xmap%npes-1) :: send_ind, pl integer :: npes, nsend, nrecv, mypos From a61ab9ed9dc39f56e87632b9a89be1d2f497dc23 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Fri, 28 Apr 2023 16:26:36 -0400 Subject: [PATCH 04/10] Update xgrid.F90 --- exchange/xgrid.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 0bfa75bb88..11c2950772 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -1187,6 +1187,8 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u y2m1_size(:) = xmap%your2my1_size(:) iarray2 => iarray jarray2 => jarray + if (allocated(iarray)) deallocate(iarray) + if (allocated(jarray)) deallocate(jarray) allocate(iarray(nxgrid1+nxgrid1_old), jarray(nxgrid1+nxgrid1_old)) ! copy the i-j index do p=0,xmap%npes-1 From 4b984ad54666373f10964194cfd2d88a748ad4c2 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Fri, 28 Apr 2023 17:02:12 -0400 Subject: [PATCH 05/10] Update xgrid.F90 --- exchange/xgrid.F90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 11c2950772..d3cfad0bcd 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -838,8 +838,10 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u endif enddo - deallocate(i1_tmp, i2_tmp, j1_tmp, j2_tmp, area_tmp) - if(use_higher_order) deallocate( di_tmp, dj_tmp) + if (allocated(i1_tmp, i2_tmp, j1_tmp, j2_tmp, area_tmp)) deallocate(i1_tmp, i2_tmp, j1_tmp, j2_tmp, area_tmp) + if(use_higher_order) then + if (allocated(di_tmp, dj_tmp)) deallocate( di_tmp, dj_tmp) + end if iec = pos if(iec .GE. isc) then nxgrid_local = iec - isc + 1 @@ -983,7 +985,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u call mpp_clock_end(id_load_xgrid4) !--- unpack buffer. if( nxgrid_local>0) then - deallocate(i1,j1,i2,j2,area) + if (allocated(i1,j1,i2,j2,area)) deallocate(i1,j1,i2,j2,area) endif allocate(i1(nxgrid2), j1(nxgrid2)) @@ -993,7 +995,9 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u allocate(i2_side1(nxgrid1), j2_side1(nxgrid1)) allocate(area_side1(nxgrid1)) if(use_higher_order) then - if(nxgrid_local>0) deallocate(di,dj) + if(nxgrid_local>0) then + if (allocated(di, dj)) deallocate(di,dj) + end if allocate(di (nxgrid2), dj (nxgrid2)) allocate(di_side1(nxgrid1), dj_side1(nxgrid1)) endif @@ -1232,9 +1236,9 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u endif end do xmap%your2my1_size(:) = y2m1_size(:) - deallocate(y2m1_pe) + if (allocated(y2m1_pe)) deallocate(y2m1_pe) if(last_grid) then - deallocate(iarray, jarray) + if (allocated(iarray, jarray)) deallocate(iarray, jarray) if(allocated(pos_s)) deallocate(pos_s) end if end if From 0095197cfce84c6164c0aff49642c9fe8f066caf Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Fri, 28 Apr 2023 17:15:23 -0400 Subject: [PATCH 06/10] Update xgrid.F90 --- exchange/xgrid.F90 | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index d3cfad0bcd..482d24ab3a 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -838,9 +838,14 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u endif enddo - if (allocated(i1_tmp, i2_tmp, j1_tmp, j2_tmp, area_tmp)) deallocate(i1_tmp, i2_tmp, j1_tmp, j2_tmp, area_tmp) + if (allocated(i1_tmp)) deallocate(i1_tmp) + if (allocated(i2_tmp)) deallocate(i2_tmp) + if (allocated(j1_tmp)) deallocate(j1_tmp) + if (allocated(j2_tmp)) deallocate(j2_tmp) + if (allocated(area_tmp)) deallocate(area_tmp) if(use_higher_order) then - if (allocated(di_tmp, dj_tmp)) deallocate( di_tmp, dj_tmp) + if (allocated(di_tmp)) deallocate(di_tmp) + if (allocated(dj_tmp)) deallocate(dj_tmp) end if iec = pos if(iec .GE. isc) then @@ -985,7 +990,11 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u call mpp_clock_end(id_load_xgrid4) !--- unpack buffer. if( nxgrid_local>0) then - if (allocated(i1,j1,i2,j2,area)) deallocate(i1,j1,i2,j2,area) + if (allocated(i1)) deallocate(i1) + if (allocated(j1)) deallocate(j1) + if (allocated(i2)) deallocate(i2) + if (allocated(j2)) deallocate(j2) + if (allocated(area)) deallocate(area) endif allocate(i1(nxgrid2), j1(nxgrid2)) @@ -996,7 +1005,8 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u allocate(area_side1(nxgrid1)) if(use_higher_order) then if(nxgrid_local>0) then - if (allocated(di, dj)) deallocate(di,dj) + if (allocated(di)) deallocate(di) + if (allocated(dj)) deallocate(dj) end if allocate(di (nxgrid2), dj (nxgrid2)) allocate(di_side1(nxgrid1), dj_side1(nxgrid1)) @@ -1238,7 +1248,8 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u xmap%your2my1_size(:) = y2m1_size(:) if (allocated(y2m1_pe)) deallocate(y2m1_pe) if(last_grid) then - if (allocated(iarray, jarray)) deallocate(iarray, jarray) + if (allocated(iarray)) deallocate(iarray) + if (allocated(jarray)) deallocate(jarray) if(allocated(pos_s)) deallocate(pos_s) end if end if From 1b543ad1cedd2abf0e0e03a5b58ab7a0d276514a Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Fri, 28 Apr 2023 17:27:26 -0400 Subject: [PATCH 07/10] Update xgrid.F90 --- exchange/xgrid.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 482d24ab3a..fd755720bb 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -1211,7 +1211,8 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u jarray(pos_x(p)+n) = jarray2(pos_s(p)+n) enddo enddo - deallocate(iarray2, jarray2) + if (associated(iarray2)) deallocate(iarray2) + if (associated(jarray2)) deallocate(jarray2) else allocate(iarray(nxgrid1), jarray(nxgrid1)) iarray(:) = 0 From ab79d120927a6cc2b5cfde8aa5d55cf25fa52d4c Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Fri, 28 Apr 2023 17:42:52 -0400 Subject: [PATCH 08/10] Update xgrid.F90 --- exchange/xgrid.F90 | 27 +++++---------------------- 1 file changed, 5 insertions(+), 22 deletions(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index fd755720bb..96d9c0a604 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -838,15 +838,8 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u endif enddo - if (allocated(i1_tmp)) deallocate(i1_tmp) - if (allocated(i2_tmp)) deallocate(i2_tmp) - if (allocated(j1_tmp)) deallocate(j1_tmp) - if (allocated(j2_tmp)) deallocate(j2_tmp) - if (allocated(area_tmp)) deallocate(area_tmp) - if(use_higher_order) then - if (allocated(di_tmp)) deallocate(di_tmp) - if (allocated(dj_tmp)) deallocate(dj_tmp) - end if + deallocate(i1_tmp, i2_tmp, j1_tmp, j2_tmp, area_tmp) + if(use_higher_order) deallocate(di_tmp, dj_tmp) iec = pos if(iec .GE. isc) then nxgrid_local = iec - isc + 1 @@ -989,13 +982,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u end if call mpp_clock_end(id_load_xgrid4) !--- unpack buffer. - if( nxgrid_local>0) then - if (allocated(i1)) deallocate(i1) - if (allocated(j1)) deallocate(j1) - if (allocated(i2)) deallocate(i2) - if (allocated(j2)) deallocate(j2) - if (allocated(area)) deallocate(area) - endif + if( nxgrid_local>0) deallocate(i1, j1, i2, j2, area) allocate(i1(nxgrid2), j1(nxgrid2)) allocate(i2(nxgrid2), j2(nxgrid2)) @@ -1004,10 +991,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u allocate(i2_side1(nxgrid1), j2_side1(nxgrid1)) allocate(area_side1(nxgrid1)) if(use_higher_order) then - if(nxgrid_local>0) then - if (allocated(di)) deallocate(di) - if (allocated(dj)) deallocate(dj) - end if + if(nxgrid_local>0) deallocate(di, dj) allocate(di (nxgrid2), dj (nxgrid2)) allocate(di_side1(nxgrid1), dj_side1(nxgrid1)) endif @@ -1249,8 +1233,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u xmap%your2my1_size(:) = y2m1_size(:) if (allocated(y2m1_pe)) deallocate(y2m1_pe) if(last_grid) then - if (allocated(iarray)) deallocate(iarray) - if (allocated(jarray)) deallocate(jarray) + deallocate(iarray, jarray) if(allocated(pos_s)) deallocate(pos_s) end if end if From 53cc8c3fed39d6c1aadbd72e2c64fc0e0e861867 Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Tue, 2 May 2023 12:39:49 -0400 Subject: [PATCH 09/10] Update xgrid.F90 Do not check iarray2 and jarray2 --- exchange/xgrid.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 96d9c0a604..bf2ef4fd0b 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -1195,8 +1195,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u jarray(pos_x(p)+n) = jarray2(pos_s(p)+n) enddo enddo - if (associated(iarray2)) deallocate(iarray2) - if (associated(jarray2)) deallocate(jarray2) + deallocate(iarray2, jarray2) else allocate(iarray(nxgrid1), jarray(nxgrid1)) iarray(:) = 0 From 1db4dc6eb4e4138e5243ebeb176ce44346c797ae Mon Sep 17 00:00:00 2001 From: ganganoaa <121043264+ganganoaa@users.noreply.github.com> Date: Tue, 2 May 2023 14:05:38 -0400 Subject: [PATCH 10/10] Update xgrid.F90 Allocatables iarray and jarray are reverted to pointers. --- exchange/xgrid.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index bf2ef4fd0b..5e14d686ea 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -637,7 +637,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u integer, dimension(2*xmap%npes) :: ibuf1, ibuf2 integer, dimension(0:xmap%npes-1) :: pos_x, y2m1_size integer, allocatable, dimension(:) :: y2m1_pe - integer, allocatable, save, target :: iarray(:), jarray(:) + integer, pointer, save :: iarray(:), jarray(:) integer, allocatable, save :: pos_s(:) integer, pointer, dimension(:) :: iarray2(:)=>NULL(), jarray2(:)=>NULL() logical :: last_grid @@ -1137,7 +1137,7 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u size_repro = 0 if(grid1%tile_me == tile1) then - if(allocated(iarray)) then + if(associated(iarray)) then nxgrid1_old = size(iarray(:)) else nxgrid1_old = 0 @@ -1185,8 +1185,6 @@ subroutine load_xgrid (xmap, grid, grid_file, grid1_id, grid_id, tile1, tile2, u y2m1_size(:) = xmap%your2my1_size(:) iarray2 => iarray jarray2 => jarray - if (allocated(iarray)) deallocate(iarray) - if (allocated(jarray)) deallocate(jarray) allocate(iarray(nxgrid1+nxgrid1_old), jarray(nxgrid1+nxgrid1_old)) ! copy the i-j index do p=0,xmap%npes-1