diff --git a/fms2_io/include/domain_read.inc b/fms2_io/include/domain_read.inc index fa404270f4..764d91a725 100644 --- a/fms2_io/include/domain_read.inc +++ b/fms2_io/include/domain_read.inc @@ -119,6 +119,7 @@ subroutine domain_read_2d(fileobj, variable_name, vdata, unlim_dim_level, & integer :: xgsize !< Size of global x io domain integer :: ygbegin !< Starting y index of global io domain integer :: ygsize !< Size of global y io domain + integer :: dim_order(2) !< Order of the dimensions type(domain2d), pointer :: io_domain !< pointer to the io_domain !< The global data is only allocated by the io root PEs @@ -164,14 +165,6 @@ subroutine domain_read_2d(fileobj, variable_name, vdata, unlim_dim_level, & return endif - if (xdim_index .ne. 1 .or. ydim_index .ne. 2) then - ! This is a KLUDGE - ! mpp_scatter assumes that the variable is (x,y), if that is not the case it remaps the data - ! to a 4D array and calls domain_read_4d which does not use mpp_scatter yet - vdata_dummy(1:size(vdata,1),1:size(vdata,2), 1:1, 1:1) => vdata(:,:) - call domain_read_4d(fileobj, variable_name, vdata_dummy, unlim_dim_level) - return - endif io_domain => mpp_get_io_domain(fileobj%domain) c(:) = 1 e(:) = shape(vdata) @@ -240,29 +233,32 @@ subroutine domain_read_2d(fileobj, variable_name, vdata, unlim_dim_level, & e(xdim_index) = xc_size e(ydim_index) = yc_size + dim_order(xdim_index) = 1 + dim_order(ydim_index) = 2 + select type(vdata) type is (integer(kind=i4_kind)) call allocate_array(buf_i4_kind_pe, e) call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, fileobj%pelist, & - buf_i4_kind_pe, buf_i4_kind, fileobj%is_root) + buf_i4_kind_pe, buf_i4_kind, dim_order, fileobj%is_root) call put_array_section(buf_i4_kind_pe, vdata, c, e) deallocate(buf_i4_kind_pe) type is (integer(kind=i8_kind)) call allocate_array(buf_i8_kind_pe, e) call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, fileobj%pelist, & - buf_i8_kind_pe, buf_i8_kind, fileobj%is_root) + buf_i8_kind_pe, buf_i8_kind, dim_order, fileobj%is_root) call put_array_section(buf_i8_kind_pe, vdata, c, e) deallocate(buf_i8_kind_pe) type is (real(kind=r4_kind)) call allocate_array(buf_r4_kind_pe, e) call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, fileobj%pelist, & - buf_r4_kind_pe, buf_r4_kind, fileobj%is_root) + buf_r4_kind_pe, buf_r4_kind, dim_order, fileobj%is_root) call put_array_section(buf_r4_kind_pe, vdata, c, e) deallocate(buf_r4_kind_pe) type is (real(kind=r8_kind)) call allocate_array(buf_r8_kind_pe, e) call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, fileobj%pelist, & - buf_r8_kind_pe, buf_r8_kind, fileobj%is_root) + buf_r8_kind_pe, buf_r8_kind, dim_order, fileobj%is_root) call put_array_section(buf_r8_kind_pe, vdata, c, e) deallocate(buf_r8_kind_pe) class default @@ -304,6 +300,7 @@ subroutine domain_read_3d(fileobj, variable_name, vdata, unlim_dim_level, & integer :: xdim_index !< The index of the variable that is the x dimension integer :: ydim_index !< The index of the variable that is the y dimension + integer :: zdim_index !< The index of the variable that is the z dimension integer :: xpos !< The position of the x axis integer :: ypos !< The position of the y axis integer :: i !< For do loops @@ -320,6 +317,7 @@ subroutine domain_read_3d(fileobj, variable_name, vdata, unlim_dim_level, & integer :: xgsize !< Size of global x io domain integer :: ygbegin !< Starting y index of global io domain integer :: ygsize !< Size of global y io domain + integer :: dim_order(3) !< Order of the dimensions type(domain2d), pointer :: io_domain !< pointer to the io_domain !< The global data is only allocated by the io root PEs @@ -365,14 +363,6 @@ subroutine domain_read_3d(fileobj, variable_name, vdata, unlim_dim_level, & return endif - if (xdim_index .ne. 1 .or. ydim_index .ne. 2) then - ! This is a KLUDGE - ! mpp_scatter assumes that the variable is (x,y), if that is not the case it remaps the data - ! to a 4D array and calls domain_read_4d which does not use mpp_scatter yet - vdata_dummy(1:size(vdata,1),1:size(vdata,2), 1:size(vdata,3), 1:1) => vdata(:,:,:) - call domain_read_4d(fileobj, variable_name, vdata_dummy, unlim_dim_level) - return - endif io_domain => mpp_get_io_domain(fileobj%domain) c(:) = 1 if (present(corner)) c = corner @@ -444,29 +434,36 @@ subroutine domain_read_3d(fileobj, variable_name, vdata, unlim_dim_level, & e(xdim_index) = xc_size e(ydim_index) = yc_size + ! Calculate the index of the z dimension + zdim_index = 6 - xdim_index - ydim_index + + dim_order(xdim_index) = 1 + dim_order(ydim_index) = 2 + dim_order(zdim_index) = 3 + select type(vdata) type is (integer(kind=i4_kind)) call allocate_array(buf_i4_kind_pe, e) - call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, e(3), fileobj%pelist, & - buf_i4_kind_pe, buf_i4_kind, fileobj%is_root) + call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, e(zdim_index), & + fileobj%pelist, buf_i4_kind_pe, buf_i4_kind, dim_order, fileobj%is_root) call put_array_section(buf_i4_kind_pe, vdata, c, e) deallocate(buf_i4_kind_pe) type is (integer(kind=i8_kind)) call allocate_array(buf_i8_kind_pe, e) - call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, e(3), fileobj%pelist, & - buf_i8_kind_pe, buf_i8_kind, fileobj%is_root) + call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, e(zdim_index), & + fileobj%pelist, buf_i8_kind_pe, buf_i8_kind, dim_order, fileobj%is_root) call put_array_section(buf_i8_kind_pe, vdata, c, e) deallocate(buf_i8_kind_pe) type is (real(kind=r4_kind)) call allocate_array(buf_r4_kind_pe, e) - call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, e(3), fileobj%pelist, & - buf_r4_kind_pe, buf_r4_kind, fileobj%is_root) + call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, e(zdim_index), & + fileobj%pelist, buf_r4_kind_pe, buf_r4_kind, dim_order, fileobj%is_root) call put_array_section(buf_r4_kind_pe, vdata, c, e) deallocate(buf_r4_kind_pe) type is (real(kind=r8_kind)) call allocate_array(buf_r8_kind_pe, e) - call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, e(3), fileobj%pelist, & - buf_r8_kind_pe, buf_r8_kind, fileobj%is_root) + call mpp_scatter(isc-xgbegin+1, isc+xc_size-xgbegin, jsc-ygbegin+1, jsc+yc_size-ygbegin, e(zdim_index), & + fileobj%pelist, buf_r8_kind_pe, buf_r8_kind, dim_order, fileobj%is_root) call put_array_section(buf_r8_kind_pe, vdata, c, e) deallocate(buf_r8_kind_pe) class default diff --git a/fms2_io/include/domain_write.inc b/fms2_io/include/domain_write.inc index 3f9d51fae7..3e8e19570f 100644 --- a/fms2_io/include/domain_write.inc +++ b/fms2_io/include/domain_write.inc @@ -121,8 +121,9 @@ subroutine domain_write_2d(fileobj, variable_name, vdata, unlim_dim_level, & class(*), dimension(:,:,:,:), pointer :: vdata_dummy !< Vdata remapped as 4D integer :: xgmin !< Starting x index of the global io domain integer :: ygmin !< Ending y index of the global io domain - integer :: xgsize, ygsize - integer :: istart, jstart, iend, jend + integer :: gsize(2) !< Shape of global_buf + integer :: dim_order(2) !< Order of the dimensions + integer :: start(2), end(2) integer :: ioff, joff if (fileobj%use_netcdf_mpi) then @@ -157,8 +158,8 @@ subroutine domain_write_2d(fileobj, variable_name, vdata, unlim_dim_level, & msg="file:"//trim(fileobj%path)//" and variable:"//trim(variable_name)) ! Get the global io domain: - call mpp_get_global_domain(io_domain, xbegin=xgmin, xsize=xgsize, position=xpos) - call mpp_get_global_domain(io_domain, ybegin=ygmin, ysize=ygsize, position=ypos) + call mpp_get_global_domain(io_domain, xbegin=xgmin, xsize=gsize(xdim_index), position=xpos) + call mpp_get_global_domain(io_domain, ybegin=ygmin, ysize=gsize(ydim_index), position=ypos) ! Root pe allocates room to gather the data and computes offsets for data placement if (fileobj%is_root) then @@ -169,25 +170,25 @@ subroutine domain_write_2d(fileobj, variable_name, vdata, unlim_dim_level, & ! Allocate recv buffer for gather select type(vdata) type is (integer(kind=i4_kind)) - allocate(global_buf_i4_kind(xgsize, ygsize)) + allocate(global_buf_i4_kind(gsize(1), gsize(2))) global_buf_i4_kind = 0 if (get_fill_value(fileobj, variable_name, fill_i4_kind, broadcast=.false.)) then global_buf_i4_kind = fill_i4_kind endif type is (integer(kind=i8_kind)) - allocate(global_buf_i8_kind(xgsize, ygsize)) + allocate(global_buf_i8_kind(gsize(1), gsize(2))) global_buf_i8_kind = 0 if (get_fill_value(fileobj, variable_name, fill_i8_kind, broadcast=.false.)) then global_buf_i8_kind = fill_i8_kind endif type is (real(kind=r4_kind)) - allocate(global_buf_r4_kind(xgsize, ygsize)) + allocate(global_buf_r4_kind(gsize(1), gsize(2))) global_buf_r4_kind = 0. if (get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) then global_buf_r4_kind = fill_r4_kind endif type is (real(kind=r8_kind)) - allocate(global_buf_r8_kind(xgsize, ygsize)) + allocate(global_buf_r8_kind(gsize(1), gsize(2))) global_buf_r8_kind = 0. if (get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) then global_buf_r8_kind = fill_r8_kind @@ -213,32 +214,38 @@ subroutine domain_write_2d(fileobj, variable_name, vdata, unlim_dim_level, & endif ! Get the starting and indices of the compute domain relative to vdata (note that vdata start indices at 1 #Fortran) - istart = 1 - jstart = 1 + start = 1 ! If the buffer contains halos, get the portion of vdata with only the compute domain if (buffer_includes_halos) then - istart = isc - isd + 1 - jstart = jsc - jsd + 1 + start(xdim_index) = isc - isd + 1 + start(ydim_index) = jsc - jsd + 1 endif - iend = istart + xc_size - 1 - jend = jstart + yc_size - 1 + end(xdim_index) = start(xdim_index) + xc_size - 1 + end(ydim_index) = start(ydim_index) + yc_size - 1 + + dim_order(xdim_index) = 1 + dim_order(ydim_index) = 2 ! Gather the data select type(vdata) type is (integer(kind=i4_kind)) - call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, fileobj%pelist, vdata(istart:iend, jstart:jend), & - & global_buf_i4_kind, fileobj%is_root, ishift=ioff, jshift=joff) + call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, fileobj%pelist, & + vdata(start(1):end(1), start(2):end(2)), global_buf_i4_kind, & + dim_order, fileobj%is_root, ishift=ioff, jshift=joff) type is (integer(kind=i8_kind)) - call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, fileobj%pelist, vdata(istart:iend, jstart:jend), & - & global_buf_i8_kind, fileobj%is_root, ishift=ioff, jshift=joff) + call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, fileobj%pelist, & + vdata(start(1):end(1), start(2):end(2)), global_buf_i8_kind, & + dim_order, fileobj%is_root, ishift=ioff, jshift=joff) type is (real(kind=r4_kind)) - call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, fileobj%pelist, vdata(istart:iend, jstart:jend), & - & global_buf_r4_kind, fileobj%is_root, ishift=ioff, jshift=joff) + call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, fileobj%pelist, & + vdata(start(1):end(1), start(2):end(2)), global_buf_r4_kind, & + dim_order, fileobj%is_root, ishift=ioff, jshift=joff) type is (real(kind=r8_kind)) - call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, fileobj%pelist, vdata(istart:iend, jstart:jend), & - & global_buf_r8_kind, fileobj%is_root, ishift=ioff, jshift=joff) + call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, fileobj%pelist, & + vdata(start(1):end(1), start(2):end(2)), global_buf_r8_kind, & + dim_order, fileobj%is_root, ishift=ioff, jshift=joff) class default call error("unsupported variable type: domain_write_2d_mpp_gather: file: " & & //trim(fileobj%path)//" variable:"// trim(variable_name)) @@ -307,6 +314,7 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & integer :: ydim_index integer :: ypos integer :: yc_size + integer :: zdim_index integer(kind=i4_kind) :: fill_i4_kind !< Fill value of a i4_kind variable integer(kind=i8_kind) :: fill_i8_kind !< Fill value of a i8_kind variable real(kind=r4_kind) :: fill_r4_kind !< Fill value of a r4_kind variable @@ -314,8 +322,9 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & class(*), dimension(:,:,:,:), pointer :: vdata_dummy !< Vdata remapped as 4D integer :: xgmin !< Starting x index of the global io domain integer :: ygmin !< Ending y index of the global io domain - integer :: xgsize, ygsize - integer :: istart, jstart, iend, jend + integer :: gsize(3) !< Shape of global_buf + integer :: dim_order(3) !< Order of the dimensions + integer :: start(3), end(3) integer :: ioff, joff if (fileobj%use_netcdf_mpi) then @@ -331,15 +340,6 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & return endif - if (xdim_index .ne. 1 .or. ydim_index .ne. 2) then - ! This is a KLUDGE - ! mpp_scatter assumes that the variable is (x,y), if that is not the case it remaps the data - ! to a 4D array and calls domain_read_4d which does not use mpp_scatter yet - vdata_dummy(1:size(vdata,1),1:size(vdata,2), 1:size(vdata,3), 1:1) => vdata(:,:,:) - call domain_write_4d(fileobj, variable_name, vdata_dummy, unlim_dim_level) - return - endif - ! Get the io domain from the fileobj io_domain => mpp_get_io_domain(fileobj%domain) @@ -348,9 +348,13 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & xpos, ypos, isd, isc, xc_size, jsd, jsc, yc_size, buffer_includes_halos, & msg="file:"//trim(fileobj%path)//" and variable:"//trim(variable_name)) + ! Calculate the index of the z dimension + zdim_index = 6 - xdim_index - ydim_index + ! Get the global io domain: - call mpp_get_global_domain(io_domain, xbegin=xgmin, xsize=xgsize, position=xpos) - call mpp_get_global_domain(io_domain, ybegin=ygmin, ysize=ygsize, position=ypos) + call mpp_get_global_domain(io_domain, xbegin=xgmin, xsize=gsize(xdim_index), position=xpos) + call mpp_get_global_domain(io_domain, ybegin=ygmin, ysize=gsize(ydim_index), position=ypos) + gsize(zdim_index) = size(vdata, zdim_index) ! Root pe allocates room to gather the data and computes offsets for data placement if (fileobj%is_root) then @@ -361,25 +365,25 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & ! Allocate recv buffer for gather select type(vdata) type is (integer(kind=i4_kind)) - allocate(global_buf_i4_kind(xgsize, ygsize, size(vdata,3))) + allocate(global_buf_i4_kind(gsize(1), gsize(2), gsize(3))) global_buf_i4_kind = 0 if (get_fill_value(fileobj, variable_name, fill_i4_kind, broadcast=.false.)) then global_buf_i4_kind = fill_i4_kind endif type is (integer(kind=i8_kind)) - allocate(global_buf_i8_kind(xgsize, ygsize, size(vdata,3))) + allocate(global_buf_i8_kind(gsize(1), gsize(2), gsize(3))) global_buf_i8_kind = 0 if (get_fill_value(fileobj, variable_name, fill_i8_kind, broadcast=.false.)) then global_buf_i8_kind = fill_i8_kind endif type is (real(kind=r4_kind)) - allocate(global_buf_r4_kind(xgsize, ygsize, size(vdata,3))) + allocate(global_buf_r4_kind(gsize(1), gsize(2), gsize(3))) global_buf_r4_kind = 0. if (get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) then global_buf_r4_kind = fill_r4_kind endif type is (real(kind=r8_kind)) - allocate(global_buf_r8_kind(xgsize, ygsize, size(vdata,3))) + allocate(global_buf_r8_kind(gsize(1), gsize(2), gsize(3))) global_buf_r8_kind = 0. if (get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) then global_buf_r8_kind = fill_r8_kind @@ -405,36 +409,44 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & endif ! Get the starting and indices of the compute domain relative to vdata(note that vdata start indices at 1 #Fortran) - istart = 1 - jstart = 1 + start = 1 ! If the buffer contains halos, get the portion of vdata with only the compute domain if (buffer_includes_halos) then - istart = isc - isd + 1 - jstart = jsc - jsd + 1 + start(xdim_index) = isc - isd + 1 + start(ydim_index) = jsc - jsd + 1 endif - iend = istart + xc_size - 1 - jend = jstart + yc_size - 1 + end(xdim_index) = start(xdim_index) + xc_size - 1 + end(ydim_index) = start(ydim_index) + yc_size - 1 + end(zdim_index) = size(vdata, zdim_index) ! Get offsets for buffer ioff = 1-xgmin joff = 1-ygmin + dim_order(xdim_index) = 1 + dim_order(ydim_index) = 2 + dim_order(zdim_index) = 3 + ! Gather the data select type(vdata) type is (integer(kind=i4_kind)) - call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, size(vdata,3), fileobj%pelist, & - & vdata(istart:iend, jstart:jend,:), global_buf_i4_kind, fileobj%is_root, ishift=ioff, jshift=joff) + call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, size(vdata, zdim_index), fileobj%pelist, & + vdata(start(1):end(1), start(2):end(2), start(3):end(3)), global_buf_i4_kind, & + dim_order, fileobj%is_root, ishift=ioff, jshift=joff) type is (integer(kind=i8_kind)) - call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, size(vdata,3), fileobj%pelist, & - & vdata(istart:iend, jstart:jend,:), global_buf_i8_kind, fileobj%is_root, ishift=ioff, jshift=joff) + call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, size(vdata, zdim_index), fileobj%pelist, & + vdata(start(1):end(1), start(2):end(2), start(3):end(3)), global_buf_i8_kind, & + dim_order, fileobj%is_root, ishift=ioff, jshift=joff) type is (real(kind=r4_kind)) - call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, size(vdata,3), fileobj%pelist, & - & vdata(istart:iend, jstart:jend,:), global_buf_r4_kind, fileobj%is_root, ishift=ioff, jshift=joff) + call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, size(vdata, zdim_index), fileobj%pelist, & + vdata(start(1):end(1), start(2):end(2), start(3):end(3)), global_buf_r4_kind, & + dim_order, fileobj%is_root, ishift=ioff, jshift=joff) type is (real(kind=r8_kind)) - call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, size(vdata,3), fileobj%pelist, & - & vdata(istart:iend, jstart:jend,:), global_buf_r8_kind, fileobj%is_root, ishift=ioff, jshift=joff) + call mpp_gather(isc, isc+xc_size-1, jsc, jsc+yc_size-1, size(vdata, zdim_index), fileobj%pelist, & + vdata(start(1):end(1), start(2):end(2), start(3):end(3)), global_buf_r8_kind, & + dim_order, fileobj%is_root, ishift=ioff, jshift=joff) class default call error("unsupported variable type: domain_write_3d_mpp_gather: file: " & & //trim(fileobj%path)//" variable:"//trim(variable_name)) diff --git a/mpp/include/mpp_gather.fh b/mpp/include/mpp_gather.fh index 5b7f16a9cb..6c40dc4e8f 100644 --- a/mpp/include/mpp_gather.fh +++ b/mpp/include/mpp_gather.fh @@ -105,9 +105,9 @@ subroutine MPP_GATHER_PELIST_2D_(is, ie, js, je, pelist, array_seg, gather_data, logical, intent(in) :: is_root_pe integer, optional, intent(in) :: ishift, jshift - integer, dimension(3) :: dim_order + integer, dimension(2) :: dim_order - dim_order = (/1,2,3/) + dim_order = (/1,2/) call mpp_gather(is, ie, js, je, pelist, array_seg, gather_data, dim_order, is_root_pe, & ishift, jshift) @@ -121,7 +121,7 @@ subroutine MPP_GATHER_PELIST_GEN_2D_(is, ie, js, je, pelist, array_seg, gather_d integer, dimension(:), intent(in) :: pelist MPP_TYPE_, dimension(:,:), contiguous, target, intent(in) :: array_seg MPP_TYPE_, dimension(:,:), contiguous, target, intent(inout) :: gather_data - integer, dimension(3), intent(in) :: dim_order + integer, dimension(2), intent(in) :: dim_order logical, intent(in) :: is_root_pe integer, optional, intent(in) :: ishift, jshift @@ -135,7 +135,7 @@ subroutine MPP_GATHER_PELIST_GEN_2D_(is, ie, js, je, pelist, array_seg, gather_d data3D => null() endif - call mpp_gather(is, ie, js, je, 1, pelist, arr3D, data3D, dim_order, is_root_pe, & + call mpp_gather(is, ie, js, je, 1, pelist, arr3D, data3D, [dim_order, 3], is_root_pe, & ishift, jshift) return diff --git a/mpp/include/mpp_scatter.fh b/mpp/include/mpp_scatter.fh index cca548ec16..b0e5c5d126 100644 --- a/mpp/include/mpp_scatter.fh +++ b/mpp/include/mpp_scatter.fh @@ -31,9 +31,9 @@ subroutine MPP_SCATTER_PELIST_2D_(is, ie, js, je, pelist, array_seg, input_data, MPP_TYPE_, dimension(:,:), contiguous, target, intent(in) :: input_data !< 2D array of input data logical, intent(in) :: is_root_pe !< operational root pe - integer, dimension(3) :: dim_order + integer, dimension(2) :: dim_order - dim_order = (/1,2,3/) + dim_order = (/1,2/) call mpp_scatter(is, ie, js, je, pelist, array_seg, input_data, dim_order, is_root_pe) @@ -47,7 +47,7 @@ subroutine MPP_SCATTER_PELIST_GEN_2D_(is, ie, js, je, pelist, array_seg, input_d !! must be in monotonic increasing order MPP_TYPE_, dimension(:,:), contiguous, target, intent(inout) :: array_seg !< 2D array of output data MPP_TYPE_, dimension(:,:), contiguous, target, intent(in) :: input_data !< 2D array of input data - integer, dimension(3), intent(in) :: dim_order + integer, dimension(2), intent(in) :: dim_order logical, intent(in) :: is_root_pe !< operational root pe MPP_TYPE_, pointer :: arr3D(:,:,:) @@ -60,7 +60,7 @@ subroutine MPP_SCATTER_PELIST_GEN_2D_(is, ie, js, je, pelist, array_seg, input_d data3D => null() endif - call mpp_scatter(is, ie, js, je, 1, pelist, arr3D, data3D, dim_order, is_root_pe) + call mpp_scatter(is, ie, js, je, 1, pelist, arr3D, data3D, [dim_order, 3], is_root_pe) return