From 4086757de099c38daf252b0db61633bbf8266c8d Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Mon, 27 Nov 2023 15:14:45 -0500 Subject: [PATCH] revert changes for optional variables --- coupler/ensemble_manager.F90 | 10 +- mosaic/grid.F90 | 2 +- mosaic2/grid2.F90 | 2 +- mpp/include/mpp_define_nest_domains.inc | 12 +-- mpp/include/mpp_do_check.fh | 8 +- mpp/include/mpp_do_checkV.fh | 8 +- mpp/include/mpp_domains_define.inc | 28 +++--- mpp/include/mpp_unstruct_domain.inc | 8 +- mpp/include/mpp_update_domains2D.fh | 50 +++++----- mpp/include/mpp_update_domains2D_ad.fh | 50 +++++----- mpp/include/mpp_update_domains2D_nonblock.fh | 92 +++++++++---------- mpp/include/mpp_update_nest_domains.fh | 64 ++++++------- mpp/include/mpp_util.inc | 12 +-- test_fms/coupler/test_coupler_2d.F90 | 2 +- test_fms/coupler/test_coupler_3d.F90 | 2 +- test_fms/coupler/test_coupler_types.F90 | 6 +- test_fms/data_override/test_data_override.F90 | 6 +- .../test_data_override_ongrid.F90 | 2 +- test_fms/data_override/test_get_grid_v1.F90 | 2 +- test_fms/diag_manager/test_diag_manager.F90 | 4 +- .../diag_manager/test_diag_manager_time.F90 | 2 +- test_fms/exchange/test_xgrid.F90 | 16 ++-- test_fms/fms2_io/create_atmosphere_domain.inc | 2 +- test_fms/fms2_io/create_land_domain.inc | 2 +- test_fms/fms2_io/create_ocean_domain.inc | 2 +- test_fms/fms2_io/setup.F90 | 6 +- test_fms/fms2_io/test_bc_restart.F90 | 2 +- test_fms/fms2_io/test_io_with_mask.F90 | 2 +- test_fms/mosaic2/test_grid2.F90 | 2 +- test_fms/mpp/test_domains_utility_mod.F90 | 6 +- test_fms/mpp/test_global_arrays.F90 | 6 +- test_fms/mpp/test_mpp_domains.F90 | 90 +++++++++--------- test_fms/mpp/test_mpp_global_field.F90 | 32 +++---- test_fms/mpp/test_mpp_global_field_ug.F90 | 6 +- test_fms/mpp/test_mpp_global_sum_ad.F90 | 4 +- test_fms/mpp/test_mpp_nesting.F90 | 24 ++--- test_fms/mpp/test_mpp_update_domains_ad.F90 | 4 +- test_fms/mpp/test_mpp_update_domains_int.F90 | 12 +-- test_fms/mpp/test_mpp_update_domains_real.F90 | 36 ++++---- test_fms/mpp/test_redistribute_int.F90 | 2 +- test_fms/mpp/test_super_grid.F90 | 2 +- .../mpp/test_update_domains_performance.F90 | 20 ++-- test_fms/mpp_io/test_io_mosaic_R4_R8.F90 | 4 +- test_fms/mpp_io/test_mpp_io.F90 | 2 +- 44 files changed, 328 insertions(+), 328 deletions(-) diff --git a/coupler/ensemble_manager.F90 b/coupler/ensemble_manager.F90 index 66994d8d00..3b4e13155a 100644 --- a/coupler/ensemble_manager.F90 +++ b/coupler/ensemble_manager.F90 @@ -125,16 +125,16 @@ function get_ensemble_size() end function get_ensemble_size !> @brief Gets pe list for current ensemble or a given ensemble component. - subroutine get_ensemble_pelist(pelist, component_name) + subroutine get_ensemble_pelist(pelist, name) integer, intent(inout) :: pelist(:,:) !< Ensemble pelist - character(len=*), intent(in), optional :: component_name !< Component name. + character(len=*), intent(in), optional :: name !< Component name. if (size(pelist,1) < ensemble_size) & call mpp_error(FATAL,'get_ensemble_pelist: size of pelist 1st index < ensemble_size') - if(present(component_name)) then - select case(component_name) + if(present(name)) then + select case(name) case('ocean') if (size(pelist,2) < ocean_npes_pm)& call mpp_error(FATAL,'get_ensemble_pelist: size of pelist 2nd index < ocean_npes_pm') @@ -164,7 +164,7 @@ subroutine get_ensemble_pelist(pelist, component_name) ensemble_pelist_ice(1:ensemble_size,1:ice_npes_pm) case default - call mpp_error(FATAL,'get_ensemble_pelist: unknown argument name='//component_name) + call mpp_error(FATAL,'get_ensemble_pelist: unknown argument name='//name) end select else if (size(pelist,2) < total_npes_pm)& diff --git a/mosaic/grid.F90 b/mosaic/grid.F90 index f6757ff064..84fd0d8cb0 100644 --- a/mosaic/grid.F90 +++ b/mosaic/grid.F90 @@ -1023,7 +1023,7 @@ subroutine define_cube_mosaic ( component, domain, layout, halo, maskmap ) pe_start=pe_start, pe_end=pe_end, symmetry=.true., & shalo = ng, nhalo = ng, whalo = ng, ehalo = ng, & maskmap = maskmap, & - domain_name = trim(component)//'Cubic-Sphere Grid' ) + name = trim(component)//'Cubic-Sphere Grid' ) deallocate(nlon,nlat,global_indices,pe_start,pe_end,layout_2d) deallocate(tile1,tile2) diff --git a/mosaic2/grid2.F90 b/mosaic2/grid2.F90 index afaccea43e..e486777744 100644 --- a/mosaic2/grid2.F90 +++ b/mosaic2/grid2.F90 @@ -409,7 +409,7 @@ subroutine define_cube_mosaic(component, domain, layout, halo, maskmap) pe_start=pe_start, pe_end=pe_end, symmetry=.true., & shalo = ng, nhalo = ng, whalo = ng, ehalo = ng, & maskmap = maskmap, & - domain_name = trim(component)//'Cubic-Sphere Grid' ) + name = trim(component)//'Cubic-Sphere Grid' ) deallocate(nlon,nlat,global_indices,pe_start,pe_end,layout_2d) deallocate(tile1,tile2) diff --git a/mpp/include/mpp_define_nest_domains.inc b/mpp/include/mpp_define_nest_domains.inc index 7946b76152..5cf1a14ea5 100644 --- a/mpp/include/mpp_define_nest_domains.inc +++ b/mpp/include/mpp_define_nest_domains.inc @@ -94,7 +94,7 @@ !! subroutine mpp_define_nest_domains(nest_domain, domain, num_nest, nest_level, tile_fine, tile_coarse, & istart_coarse, icount_coarse, jstart_coarse, jcount_coarse, npes_nest_tile, & - x_refine, y_refine, extra_halo, domain_name) + x_refine, y_refine, extra_halo, name) type(nest_domain_type), 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 @@ -114,7 +114,7 @@ subroutine mpp_define_nest_domains(nest_domain, domain, num_nest, nest_level, ti !! for each nest integer, optional, intent(in ) :: extra_halo !< extra halo for passing data from coarse grid to fine grid. !! default is 0 and currently only support extra_halo = 0. - character(len=*), optional, intent(in ) :: domain_name !< name of the nest domain + character(len=*), optional, intent(in ) :: name !< name of the nest domain integer :: n, l, m, my_tile_coarse integer :: npes_level, prev_tile_coarse @@ -126,13 +126,13 @@ subroutine mpp_define_nest_domains(nest_domain, domain, num_nest, nest_level, ti integer :: nnest, nlevels, ntiles_top, ntiles, pos logical :: is_first - if(PRESENT(domain_name)) then - if(len_trim(domain_name) > NAME_LENGTH) then + if(PRESENT(name)) then + if(len_trim(name) > NAME_LENGTH) then call mpp_error(FATAL, "mpp_domains_define.inc(mpp_define_nest_domain): "// & - "the len_trim of optional argument name ="//trim(domain_name)// & + "the len_trim of optional argument name ="//trim(name)// & " is greater than NAME_LENGTH, change the argument name or increase NAME_LENGTH") endif - nest_domain%domain_name = domain_name + nest_domain%domain_name = name endif extra_halo_local = 0 diff --git a/mpp/include/mpp_do_check.fh b/mpp/include/mpp_do_check.fh index 1ec676e37f..ebd0ce0e08 100644 --- a/mpp/include/mpp_do_check.fh +++ b/mpp/include/mpp_do_check.fh @@ -24,14 +24,14 @@ !> @{ !> Updates data domain of 3D field whose computational domains have been computed - subroutine MPP_DO_CHECK_3D_( f_addrs, domain, check, d_type, ke, flags, fieldname) + subroutine MPP_DO_CHECK_3D_( f_addrs, domain, check, d_type, ke, flags, name) integer(i8_kind), intent(in) :: f_addrs(:,:) type(domain2D), intent(in) :: domain type(overlapSpec), intent(in) :: check MPP_TYPE_, intent(in) :: d_type ! Updates data domain of 3D field whose computational domains have been computed subroutine MPP_DO_CHECK_3D_V_(f_addrsx,f_addrsy, domain, check_x, check_y, & - d_type, ke, flags, fieldname) + d_type, ke, flags, name) integer(i8_kind), intent(in) :: f_addrsx(:,:), f_addrsy(:,:) type(domain2d), intent(in) :: domain type(overlapSpec), intent(in) :: check_x, check_y integer, intent(in) :: ke MPP_TYPE_, intent(in) :: d_type ! creates unique interface integer, intent(in), optional :: flags - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name MPP_TYPE_ :: fieldx(check_x%xbegin:check_x%xend, check_x%ybegin:check_x%yend,ke) MPP_TYPE_ :: fieldy(check_y%xbegin:check_y%xend, check_y%ybegin:check_y%yend,ke) @@ -71,8 +71,8 @@ !--- The check will be done in the following way: Western boundary data sent to Eastern boundary to check !--- and Southern boundary to check - if(present(fieldname)) then - field_name = fieldname + if(present(name)) then + field_name = name else field_name = "un-named" end if diff --git a/mpp/include/mpp_domains_define.inc b/mpp/include/mpp_domains_define.inc index a54b1fe2cd..5b4a8da5e8 100644 --- a/mpp/include/mpp_domains_define.inc +++ b/mpp/include/mpp_domains_define.inc @@ -606,7 +606,7 @@ !> Define 2D data and computational domain on global rectilinear cartesian domain !! (isg:ieg,jsg:jeg) and assign them to PEs subroutine mpp_define_domains2D( global_indices, layout, domain, pelist, xflags, yflags, & - xhalo, yhalo, xextent, yextent, maskmap, domain_name, symmetry, memory_size, & + xhalo, yhalo, xextent, yextent, maskmap, name, symmetry, memory_size, & 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 @@ -616,7 +616,7 @@ integer, intent(in), optional :: xhalo, yhalo !< halo sizes for x and y indices integer, intent(in), optional :: xextent(0:), yextent(0:) logical, intent(in), optional :: maskmap(0:,0:) - character(len=*), intent(in), optional :: domain_name + character(len=*), intent(in), optional :: name logical, intent(in), optional :: symmetry logical, intent(in), optional :: is_mosaic !< indicate if calling mpp_define_domains !! from mpp_define_mosaic. @@ -661,11 +661,11 @@ outunit = stdout() if( .NOT.module_is_initialized )call mpp_error( FATAL, & & 'MPP_DEFINE_DOMAINS2D: You must first call mpp_domains_init.' ) - if(PRESENT(domain_name)) then - if(len_trim(domain_name) > NAME_LENGTH) call mpp_error(FATAL, & - "mpp_domains_define.inc(mpp_define_domains2D): the len_trim of optional argument name ="//trim(domain_name)// & + if(PRESENT(name)) then + if(len_trim(name) > NAME_LENGTH) call mpp_error(FATAL, & + "mpp_domains_define.inc(mpp_define_domains2D): the len_trim of optional argument name ="//trim(name)// & " is greater than NAME_LENGTH, change the argument name or increase NAME_LENGTH") - domain%domain_name = domain_name + domain%domain_name = name endif if(size(global_indices(:)) .NE. 4) call mpp_error(FATAL, & "mpp_define_domains2D: size of global_indices should be 4 for "//trim(domain%domain_name) ) @@ -1006,9 +1006,9 @@ end if !set up domain%list - if( mpp_pe().EQ.pes(0) .AND. PRESENT(domain_name) )then + if( mpp_pe().EQ.pes(0) .AND. PRESENT(name) )then logunit = stdlog() - write( logunit, '(/a,i5,a,i5)' )trim(domain_name)//' domain decomposition: ', ndivx, ' X', ndivy + write( logunit, '(/a,i5,a,i5)' )trim(name)//' domain decomposition: ', ndivx, ' X', ndivy write( logunit, '(3x,a)' )'pe, is, ie, js, je, isd, ied, jsd, jed' end if end if ! if( ANY(pes == mpp_pe()) ) @@ -1102,8 +1102,8 @@ !print out decomposition, this didn't consider maskmap. - if( mpp_pe() .EQ. pes(0) .AND. PRESENT(domain_name) )then - write(*,*) trim(domain_name)//' domain decomposition' + if( mpp_pe() .EQ. pes(0) .AND. PRESENT(name) )then + write(*,*) trim(name)//' domain decomposition' write(*,'(a,i4,a,i4,a,i4,a,i4)')'whalo = ', whalosz, ", ehalo = ", ehalosz, ", shalo = ", shalosz, & & ", nhalo = ", nhalosz write (*,110) (domain%x(1)%list(i)%compute%size, i= 0, layout(1)-1) @@ -1197,7 +1197,7 @@ end subroutine check_message_size subroutine mpp_define_mosaic( global_indices, layout, domain, num_tile, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, pe_start, & pe_end, pelist, whalo, ehalo, shalo, nhalo, xextent, yextent, & - maskmap, domain_name, memory_size, symmetry, xflags, yflags, tile_id ) + maskmap, name, memory_size, symmetry, xflags, yflags, tile_id ) integer, intent(in) :: global_indices(:,:) !>The size of first indice is 4, !! (/ isg, ieg, jsg, jeg /) !!The size of second indice @@ -1217,7 +1217,7 @@ end subroutine check_message_size integer, intent(in), optional :: whalo, ehalo, shalo, nhalo integer, intent(in), optional :: xextent(:,:), yextent(:,:) logical, intent(in), optional :: maskmap(:,:,:) - character(len=*), intent(in), optional :: domain_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: memory_size(2) logical, intent(in), optional :: symmetry integer, intent(in), optional :: xflags, yflags @@ -1439,12 +1439,12 @@ end subroutine check_message_size end do call mpp_define_domains(global_indices(:,n), layout(:,n), domain, pelist=pelist_tile, xflags = flags_x, & yflags = flags_y, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - xextent=xext, yextent=yext, maskmap=mask, domain_name=domain_name, symmetry=is_symmetry, & + xextent=xext, yextent=yext, maskmap=mask, name=name, symmetry=is_symmetry, & memory_size = memory_size, is_mosaic = .true., tile_id=tile_id_local(n)) else call mpp_define_domains(global_indices(:,n), layout(:,n), domain, pelist=pelist_tile, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, xextent=xext, yextent=yext, & - maskmap=mask, domain_name=domain_name, symmetry=is_symmetry, memory_size = memory_size, & + maskmap=mask, name=name, symmetry=is_symmetry, memory_size = memory_size, & is_mosaic = .true., tile_count = tile_count(pe_start(n)), tile_id=tile_id_local(n), & complete = n==num_tile) end if diff --git a/mpp/include/mpp_unstruct_domain.inc b/mpp/include/mpp_unstruct_domain.inc index 3a067d6e2d..2b88c630a1 100644 --- a/mpp/include/mpp_unstruct_domain.inc +++ b/mpp/include/mpp_unstruct_domain.inc @@ -23,7 +23,7 @@ !> @{ !##################################################################### subroutine mpp_define_unstruct_domain(UG_domain, SG_domain, npts_tile, grid_nlev, ndivs, npes_io_group, & - & grid_index, domain_name) + & grid_index, name) type(domainUG), intent(inout) :: UG_domain type(domain2d), target, intent(in) :: SG_domain integer, intent(in) :: npts_tile(:) !< number of unstructured points on each tile @@ -33,7 +33,7 @@ !! Only pe with same tile_id !! in the same group integer, intent(in) :: grid_index(:) - character(len=*), optional, intent(in) :: domain_name + character(len=*), optional, intent(in) :: name integer, dimension(size(npts_tile(:))) :: ndivs_tile, pe_start, pe_end integer, dimension(0:ndivs-1) :: ibegin, iend, costs_list integer :: ntiles, ndivs_used, cur_tile @@ -161,8 +161,8 @@ enddo !--- write out domain decomposition from root pe - if(mpp_pe() == mpp_root_pe() .and. present(domain_name)) then - write(stdout(),*) "unstruct domain name = ", trim(domain_name) + if(mpp_pe() == mpp_root_pe() .and. present(name)) then + write(stdout(),*) "unstruct domain name = ", trim(name) write(stdout(),*) UG_domain%list(:)%compute%size endif diff --git a/mpp/include/mpp_update_domains2D.fh b/mpp/include/mpp_update_domains2D.fh index 0b10715cd5..8f13cd235a 100644 --- a/mpp/include/mpp_update_domains2D.fh +++ b/mpp/include/mpp_update_domains2D.fh @@ -21,34 +21,34 @@ !> @{ !> Updates data domain of 2D field whose computational domains have been computed subroutine MPP_UPDATE_DOMAINS_2D_( field, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, str_name, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) MPP_TYPE_, intent(inout) :: field(:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags logical, intent(in), optional :: complete integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: str_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3D(size(field,1),size(field,2),1) pointer( ptr, field3D ) ptr = LOC(field) call mpp_update_domains( field3D, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, str_name, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) return end subroutine MPP_UPDATE_DOMAINS_2D_ !> Updates data domain of 3D field whose computational domains have been computed subroutine MPP_UPDATE_DOMAINS_3D_( field, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, str_name, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) MPP_TYPE_, intent(inout) :: field(:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags logical, intent(in), optional :: complete integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: str_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer :: update_position, update_whalo, update_ehalo, update_shalo, update_nhalo, ntile @@ -153,7 +153,7 @@ if(debug_update_level .NE. NO_CHECK) then check => search_check_overlap(domain, update_position) if(ASSOCIATED(check) ) then - call mpp_do_check(f_addrs(1:l_size,1:ntile), domain, check, d_type, ke, flags, str_name ) + 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, & @@ -178,34 +178,34 @@ !> Updates data domain of 4D field whose computational domains have been computed subroutine MPP_UPDATE_DOMAINS_4D_( field, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, str_name, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) MPP_TYPE_, intent(inout) :: field(:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags logical, intent(in), optional :: complete integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: str_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3D(size(field,1),size(field,2),size(field,3)*size(field,4)) pointer( ptr, field3D ) ptr = LOC(field) call mpp_update_domains( field3D, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, str_name, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) return end subroutine MPP_UPDATE_DOMAINS_4D_ !> Updates data domain of 5D field whose computational domains have been computed subroutine MPP_UPDATE_DOMAINS_5D_( field, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, str_name, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) MPP_TYPE_, intent(inout) :: field(:,:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags logical, intent(in), optional :: complete integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: str_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3D(size(field,1),size(field,2),size(field,3)*size(field,4)*size(field,5)) @@ -213,7 +213,7 @@ pointer( ptr, field3D ) ptr = LOC(field) call mpp_update_domains( field3D, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, str_name, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) return end subroutine MPP_UPDATE_DOMAINS_5D_ @@ -397,14 +397,14 @@ !VECTOR_FIELD_ is set to false for MPP_TYPE_ integer. !vector fields subroutine MPP_UPDATE_DOMAINS_2D_V_( fieldx, fieldy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, str_name, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) !updates data domain of 2D field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:), fieldy(:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype logical, intent(in), optional :: complete integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: str_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3Dx(size(fieldx,1),size(fieldx,2),1) @@ -414,20 +414,20 @@ ptrx = LOC(fieldx) ptry = LOC(fieldy) call mpp_update_domains( field3Dx, field3Dy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, str_name, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) return end subroutine MPP_UPDATE_DOMAINS_2D_V_ subroutine MPP_UPDATE_DOMAINS_3D_V_( fieldx, fieldy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, str_name, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) !updates data domain of 3D field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:), fieldy(:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype logical, intent(in), optional :: complete integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: str_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer :: update_whalo, update_ehalo, update_shalo, update_nhalo, ntile @@ -567,10 +567,10 @@ if(ASSOCIATED(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, str_name) + checky, checkx, d_type, ke, flags, name) else call mpp_do_check(f_addrsx(1:l_size,1:ntile),f_addrsy(1:l_size,1:ntile), domain, & - checkx, checky, d_type, ke, flags, str_name) + checkx, checky, d_type, ke, flags, name) end if endif endif @@ -594,14 +594,14 @@ subroutine MPP_UPDATE_DOMAINS_4D_V_( fieldx, fieldy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, str_name, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) !updates data domain of 4D field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:,:), fieldy(:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype logical, intent(in), optional :: complete integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: str_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3Dx(size(fieldx,1),size(fieldx,2),size(fieldx,3)*size(fieldx,4)) @@ -612,19 +612,19 @@ ptrx = LOC(fieldx) ptry = LOC(fieldy) call mpp_update_domains( field3Dx, field3Dy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, str_name, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) return end subroutine MPP_UPDATE_DOMAINS_4D_V_ subroutine MPP_UPDATE_DOMAINS_5D_V_( fieldx, fieldy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, str_name, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) !updates data domain of 5D field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:,:,:), fieldy(:,:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype logical, intent(in), optional :: complete integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: str_name + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3Dx(size(fieldx,1),size(fieldx,2),size(fieldx,3)*size(fieldx,4)*size(fieldx,5)) @@ -634,7 +634,7 @@ ptrx = LOC(fieldx) ptry = LOC(fieldy) call mpp_update_domains( field3Dx, field3Dy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, str_name, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) return end subroutine MPP_UPDATE_DOMAINS_5D_V_ diff --git a/mpp/include/mpp_update_domains2D_ad.fh b/mpp/include/mpp_update_domains2D_ad.fh index 82f7c26e6f..8a876fdba5 100644 --- a/mpp/include/mpp_update_domains2D_ad.fh +++ b/mpp/include/mpp_update_domains2D_ad.fh @@ -21,34 +21,34 @@ !> @{ !> Updates data domain of 2D ad field whose computational domains have been computed subroutine MPP_UPDATE_DOMAINS_AD_2D_( field, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) MPP_TYPE_, intent(inout) :: field(:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags logical, intent(in), optional :: complete integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3D(size(field,1),size(field,2),1) pointer( ptr, field3D ) ptr = LOC(field) call mpp_update_domains_ad( field3D, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) return end subroutine MPP_UPDATE_DOMAINS_AD_2D_ !> Updates data domain of 3D ad field whose computational domains have been computed subroutine MPP_UPDATE_DOMAINS_AD_3D_( field, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) MPP_TYPE_, intent(inout) :: field(:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags logical, intent(in), optional :: complete integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer :: update_position, update_whalo, update_ehalo, update_shalo, update_nhalo, ntile @@ -153,7 +153,7 @@ if(debug_update_level .NE. NO_CHECK) then check => search_check_overlap(domain, update_position) if(ASSOCIATED(check) ) then - call mpp_do_check(f_addrs(1:l_size,1:ntile), domain, check, d_type, ke, flags, fieldname ) + 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, & @@ -178,34 +178,34 @@ !> Updates data domain of 4D ad field whose computational domains have been computed subroutine MPP_UPDATE_DOMAINS_AD_4D_( field, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) MPP_TYPE_, intent(inout) :: field(:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags logical, intent(in), optional :: complete integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3D(size(field,1),size(field,2),size(field,3)*size(field,4)) pointer( ptr, field3D ) ptr = LOC(field) call mpp_update_domains_ad( field3D, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) return end subroutine MPP_UPDATE_DOMAINS_AD_4D_ !> Updates data domain of 5D ad field whose computational domains have been computed subroutine MPP_UPDATE_DOMAINS_AD_5D_( field, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) MPP_TYPE_, intent(inout) :: field(:,:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags logical, intent(in), optional :: complete integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3D(size(field,1),size(field,2),size(field,3)*size(field,4)*size(field,5)) @@ -213,7 +213,7 @@ pointer( ptr, field3D ) ptr = LOC(field) call mpp_update_domains_ad( field3D, domain, flags, complete, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) return end subroutine MPP_UPDATE_DOMAINS_AD_5D_ @@ -223,14 +223,14 @@ !VECTOR_FIELD_ is set to false for MPP_TYPE_ integer. !vector fields subroutine MPP_UPDATE_DOMAINS_AD_2D_V_( fieldx, fieldy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) !updates data domain of 2D ad field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:), fieldy(:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype logical, intent(in), optional :: complete integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3Dx(size(fieldx,1),size(fieldx,2),1) @@ -240,20 +240,20 @@ ptrx = LOC(fieldx) ptry = LOC(fieldy) call mpp_update_domains_ad( field3Dx, field3Dy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) return end subroutine MPP_UPDATE_DOMAINS_AD_2D_V_ subroutine MPP_UPDATE_DOMAINS_AD_3D_V_( fieldx, fieldy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) !updates data domain of 3D ad field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:), fieldy(:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype logical, intent(in), optional :: complete integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer :: update_whalo, update_ehalo, update_shalo, update_nhalo, ntile @@ -394,10 +394,10 @@ if(ASSOCIATED(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, fieldname) + checky, checkx, d_type, ke, flags, name) else call mpp_do_check(f_addrsx(1:l_size,1:ntile),f_addrsy(1:l_size,1:ntile), domain, & - checkx, checky, d_type, ke, flags, fieldname) + checkx, checky, d_type, ke, flags, name) end if endif endif @@ -421,14 +421,14 @@ subroutine MPP_UPDATE_DOMAINS_AD_4D_V_( fieldx, fieldy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) !updates data domain of 4D ad field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:,:), fieldy(:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype logical, intent(in), optional :: complete integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3Dx(size(fieldx,1),size(fieldx,2),size(fieldx,3)*size(fieldx,4)) @@ -439,19 +439,19 @@ ptrx = LOC(fieldx) ptry = LOC(fieldy) call mpp_update_domains_ad( field3Dx, field3Dy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) return end subroutine MPP_UPDATE_DOMAINS_AD_4D_V_ subroutine MPP_UPDATE_DOMAINS_AD_5D_V_( fieldx, fieldy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count ) + whalo, ehalo, shalo, nhalo, name, tile_count ) !updates data domain of 5D ad field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:,:,:), fieldy(:,:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype logical, intent(in), optional :: complete integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count MPP_TYPE_ :: field3Dx(size(fieldx,1),size(fieldx,2),size(fieldx,3)*size(fieldx,4)*size(fieldx,5)) @@ -461,7 +461,7 @@ ptrx = LOC(fieldx) ptry = LOC(fieldy) call mpp_update_domains_ad( field3Dx, field3Dy, domain, flags, gridtype, complete, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count) + whalo, ehalo, shalo, nhalo, name, tile_count) return end subroutine MPP_UPDATE_DOMAINS_AD_5D_V_ diff --git a/mpp/include/mpp_update_domains2D_nonblock.fh b/mpp/include/mpp_update_domains2D_nonblock.fh index 273338ae01..7549abb533 100644 --- a/mpp/include/mpp_update_domains2D_nonblock.fh +++ b/mpp/include/mpp_update_domains2D_nonblock.fh @@ -19,13 +19,13 @@ !> @addtogroup mpp_domains_mod !> @{ function MPP_START_UPDATE_DOMAINS_2D_( field, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete) type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: field(:,:) integer, intent(in), optional :: flags integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer, intent(in), optional :: update_id logical, intent(in), optional :: complete @@ -36,20 +36,20 @@ function MPP_START_UPDATE_DOMAINS_2D_( field, domain, flags, position, & ptr = LOC(field) MPP_START_UPDATE_DOMAINS_2D_ = mpp_start_update_domains(field3D, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete) return end function MPP_START_UPDATE_DOMAINS_2D_ function MPP_START_UPDATE_DOMAINS_3D_( field, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: field(domain%x(1)%domain_data%begin:,domain%y(1)%domain_data%begin:,:) integer, intent(in), optional :: flags integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer, intent(in), optional :: update_id logical, intent(in), optional :: complete @@ -70,7 +70,7 @@ function MPP_START_UPDATE_DOMAINS_3D_( field, domain, flags, position, & MPP_TYPE_ :: d_type field_name = "unknown" - if(present(fieldname)) field_name = fieldname + if(present(name)) field_name = name if(present(whalo)) then update_whalo = whalo @@ -244,13 +244,13 @@ end function MPP_START_UPDATE_DOMAINS_3D_ !########################################################################################## function MPP_START_UPDATE_DOMAINS_4D_( field, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: field(:,:,:,:) integer, intent(in), optional :: flags integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer, intent(in), optional :: update_id logical, intent(in), optional :: complete @@ -261,20 +261,20 @@ function MPP_START_UPDATE_DOMAINS_4D_( field, domain, flags, position, & ptr = LOC(field) MPP_START_UPDATE_DOMAINS_4D_ = mpp_start_update_domains(field3D, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete) return end function MPP_START_UPDATE_DOMAINS_4D_ !########################################################################################## function MPP_START_UPDATE_DOMAINS_5D_( field, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete) type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: field(:,:,:,:,:) integer, intent(in), optional :: flags integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer, intent(in), optional :: update_id logical, intent(in), optional :: complete @@ -285,21 +285,21 @@ function MPP_START_UPDATE_DOMAINS_5D_( field, domain, flags, position, & ptr = LOC(field) MPP_START_UPDATE_DOMAINS_5D_ = mpp_start_update_domains(field3D, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) return end function MPP_START_UPDATE_DOMAINS_5D_ !################################################################################## subroutine MPP_COMPLETE_UPDATE_DOMAINS_2D_( id_update, field, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) integer, intent(in) :: id_update type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: field(:,:) integer, intent(in), optional :: flags integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count logical, intent(in), optional :: complete @@ -307,20 +307,20 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_2D_( id_update, field, domain, flags, pos pointer( ptr, field3D ) ptr = LOC(field) call mpp_complete_update_domains(id_update, field3D, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) end subroutine MPP_COMPLETE_UPDATE_DOMAINS_2D_ !################################################################################## subroutine MPP_COMPLETE_UPDATE_DOMAINS_3D_( id_update, field, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) integer, intent(in) :: id_update type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: field(domain%x(1)%domain_data%begin:,domain%y(1)%domain_data%begin:,:) integer, intent(in), optional :: flags integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count logical, intent(in), optional :: complete @@ -462,14 +462,14 @@ end subroutine MPP_COMPLETE_UPDATE_DOMAINS_3D_ !################################################################################## subroutine MPP_COMPLETE_UPDATE_DOMAINS_4D_( id_update, field, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) integer, intent(in) :: id_update type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: field(:,:,:,:) integer, intent(in), optional :: flags integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count logical, intent(in), optional :: complete @@ -477,20 +477,20 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_4D_( id_update, field, domain, flags, pos pointer( ptr, field3D ) ptr = LOC(field) call mpp_complete_update_domains(id_update, field3D, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) end subroutine MPP_COMPLETE_UPDATE_DOMAINS_4D_ !################################################################################## subroutine MPP_COMPLETE_UPDATE_DOMAINS_5D_( id_update, field, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) integer, intent(in) :: id_update type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: field(:,:,:,:,:) integer, intent(in), optional :: flags integer, intent(in), optional :: position integer, intent(in), optional :: whalo, ehalo, shalo, nhalo ! specify halo region to be updated. - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count logical, intent(in), optional :: complete @@ -498,19 +498,19 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_5D_( id_update, field, domain, flags, pos pointer( ptr, field3D ) ptr = LOC(field) call mpp_complete_update_domains(id_update, field3D, domain, flags, position, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) end subroutine MPP_COMPLETE_UPDATE_DOMAINS_5D_ #ifdef VECTOR_FIELD_ function MPP_START_UPDATE_DOMAINS_2D_V_( fieldx, fieldy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) !updates data domain of 3D field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:), fieldy(:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer, intent(in), optional :: update_id logical, intent(in), optional :: complete @@ -523,7 +523,7 @@ function MPP_START_UPDATE_DOMAINS_2D_V_( fieldx, fieldy, domain, flags, gridtype ptry = LOC(fieldy) MPP_START_UPDATE_DOMAINS_2D_V_ = mpp_start_update_domains(field3Dx, field3Dy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) return @@ -531,13 +531,13 @@ end function MPP_START_UPDATE_DOMAINS_2D_V_ !################################################################################### function MPP_START_UPDATE_DOMAINS_3D_V_( fieldx, fieldy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) !updates data domain of 3D field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:), fieldy(:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer, intent(in), optional :: update_id logical, intent(in), optional :: complete @@ -559,7 +559,7 @@ function MPP_START_UPDATE_DOMAINS_3D_V_( fieldx, fieldy, domain, flags, gridtype MPP_TYPE_ :: d_type field_name = "unknown" - if(present(fieldname)) field_name = fieldname + if(present(name)) field_name = name if(present(whalo)) then update_whalo = whalo @@ -772,13 +772,13 @@ function MPP_START_UPDATE_DOMAINS_3D_V_( fieldx, fieldy, domain, flags, gridtype end function MPP_START_UPDATE_DOMAINS_3D_V_ function MPP_START_UPDATE_DOMAINS_4D_V_( fieldx, fieldy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) !updates data domain of 3D field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:,:), fieldy(:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer, intent(in), optional :: update_id logical, intent(in), optional :: complete @@ -791,20 +791,20 @@ function MPP_START_UPDATE_DOMAINS_4D_V_( fieldx, fieldy, domain, flags, gridtype ptry = LOC(fieldy) MPP_START_UPDATE_DOMAINS_4D_V_ = mpp_start_update_domains(field3Dx, field3Dy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) return end function MPP_START_UPDATE_DOMAINS_4D_V_ function MPP_START_UPDATE_DOMAINS_5D_V_( fieldx, fieldy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) !updates data domain of 3D field whose computational domains have been computed MPP_TYPE_, intent(inout) :: fieldx(:,:,:,:,:), fieldy(:,:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count integer, intent(in), optional :: update_id logical, intent(in), optional :: complete @@ -817,7 +817,7 @@ function MPP_START_UPDATE_DOMAINS_5D_V_( fieldx, fieldy, domain, flags, gridtype ptry = LOC(fieldy) MPP_START_UPDATE_DOMAINS_5D_V_ = mpp_start_update_domains(field3Dx, field3Dy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, update_id, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, update_id, complete ) return @@ -825,14 +825,14 @@ end function MPP_START_UPDATE_DOMAINS_5D_V_ !#################################################################################### subroutine MPP_COMPLETE_UPDATE_DOMAINS_2D_V_( id_update, fieldx, fieldy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) !updates data domain of 3D field whose computational domains have been computed integer, intent(in) :: id_update MPP_TYPE_, intent(inout) :: fieldx(:,:), fieldy(:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count logical, intent(in), optional :: complete @@ -844,7 +844,7 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_2D_V_( id_update, fieldx, fieldy, domain, ptry = LOC(fieldy) call mpp_complete_update_domains(id_update, field3Dx, field3Dy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) return @@ -852,14 +852,14 @@ end subroutine MPP_COMPLETE_UPDATE_DOMAINS_2D_V_ !#################################################################################### subroutine MPP_COMPLETE_UPDATE_DOMAINS_3D_V_( id_update, fieldx, fieldy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) !updates data domain of 3D field whose computational domains have been computed integer, intent(in) :: id_update MPP_TYPE_, intent(inout) :: fieldx(:,:,:), fieldy(:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count logical, intent(in), optional :: complete @@ -1045,14 +1045,14 @@ end subroutine MPP_COMPLETE_UPDATE_DOMAINS_3D_V_ !#################################################################################### subroutine MPP_COMPLETE_UPDATE_DOMAINS_4D_V_( id_update, fieldx, fieldy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) !updates data domain of 3D field whose computational domains have been computed integer, intent(in) :: id_update MPP_TYPE_, intent(inout) :: fieldx(:,:,:,:), fieldy(:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count logical, intent(in), optional :: complete @@ -1064,7 +1064,7 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_4D_V_( id_update, fieldx, fieldy, domain, ptry = LOC(fieldy) call mpp_complete_update_domains(id_update, field3Dx, field3Dy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) return @@ -1072,14 +1072,14 @@ end subroutine MPP_COMPLETE_UPDATE_DOMAINS_4D_V_ !#################################################################################### subroutine MPP_COMPLETE_UPDATE_DOMAINS_5D_V_( id_update, fieldx, fieldy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) !updates data domain of 3D field whose computational domains have been computed integer, intent(in) :: id_update MPP_TYPE_, intent(inout) :: fieldx(:,:,:,:,:), fieldy(:,:,:,:,:) type(domain2D), intent(inout) :: domain integer, intent(in), optional :: flags, gridtype integer, intent(in), optional :: whalo, ehalo, shalo, nhalo - character(len=*), intent(in), optional :: fieldname + character(len=*), intent(in), optional :: name integer, intent(in), optional :: tile_count logical, intent(in), optional :: complete @@ -1091,7 +1091,7 @@ subroutine MPP_COMPLETE_UPDATE_DOMAINS_5D_V_( id_update, fieldx, fieldy, domain, ptry = LOC(fieldy) call mpp_complete_update_domains(id_update, field3Dx, field3Dy, domain, flags, gridtype, & - whalo, ehalo, shalo, nhalo, fieldname, tile_count, complete ) + whalo, ehalo, shalo, nhalo, name, tile_count, complete ) return diff --git a/mpp/include/mpp_update_nest_domains.fh b/mpp/include/mpp_update_nest_domains.fh index e0126a910e..054bc4ba2b 100644 --- a/mpp/include/mpp_update_nest_domains.fh +++ b/mpp/include/mpp_update_nest_domains.fh @@ -20,7 +20,7 @@ !> @addtogroup mpp_domains_mod !> @{ subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffer, nbuffer, & - nest_level, flags, complete, position, extra_halo, domain_name, tile_count) + nest_level, flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) :: field(:,:) !< field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data !! between fine and coarse grid. @@ -42,7 +42,7 @@ subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffe integer, intent(in), optional :: extra_halo !< extra halo for passing data !! from coarse grid to fine grid. !! Default is 0 and currently only support extra_halo = 0. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain. + character(len=*), intent(in), optional :: name !< Name of the nest domain. integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -62,7 +62,7 @@ subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffe ptr_s = LOC(sbuffer) ptr_n = LOC(nbuffer) call mpp_update_nest_fine( field3D, nest_domain, wbuffer3D, ebuffer3D, sbuffer3D, nbuffer3D, & - nest_level, flags, complete, position, extra_halo, domain_name, tile_count) + nest_level, flags, complete, position, extra_halo, name, tile_count) return @@ -70,7 +70,7 @@ subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffe end subroutine MPP_UPDATE_NEST_FINE_2D_ subroutine MPP_UPDATE_NEST_FINE_3D_(field, nest_domain, wbuffer, sbuffer, ebuffer, nbuffer, & - nest_level, flags, complete, position, extra_halo, domain_name, tile_count) + nest_level, flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) :: field(:,:,:) !< field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data !! between fine and coarse grid. @@ -92,7 +92,7 @@ subroutine MPP_UPDATE_NEST_FINE_3D_(field, nest_domain, wbuffer, sbuffer, ebuffe integer, intent(in), optional :: extra_halo !< extra halo for passing data !! from coarse grid to fine grid. !! Default is 0 and currently only support extra_halo = 0. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain. + character(len=*), intent(in), optional :: name !< Name of the nest domain. integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -208,7 +208,7 @@ end subroutine MPP_UPDATE_NEST_FINE_3D_ !############################################################################### subroutine MPP_UPDATE_NEST_FINE_4D_(field, nest_domain, wbuffer, ebuffer, sbuffer, nbuffer, & - nest_level, flags, complete, position, extra_halo, domain_name, tile_count) + nest_level, flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) :: field(:,:,:,:) !< field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data !! between fine and coarse grid. @@ -230,7 +230,7 @@ subroutine MPP_UPDATE_NEST_FINE_4D_(field, nest_domain, wbuffer, ebuffer, sbuffe integer, intent(in), optional :: extra_halo !< extra halo for passing data !! from coarse grid to fine grid. !! Default is 0 and currently only support extra_halo = 0. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain. + character(len=*), intent(in), optional :: name !< Name of the nest domain. integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -251,7 +251,7 @@ subroutine MPP_UPDATE_NEST_FINE_4D_(field, nest_domain, wbuffer, ebuffer, sbuffe ptr_s = LOC(sbuffer) ptr_n = LOC(nbuffer) call mpp_update_nest_fine( field3D, nest_domain, wbuffer3D, ebuffer3D, sbuffer3D, nbuffer3D, & - nest_level, flags, complete, position, extra_halo, domain_name, tile_count) + nest_level, flags, complete, position, extra_halo, name, tile_count) return @@ -261,7 +261,7 @@ end subroutine MPP_UPDATE_NEST_FINE_4D_ #ifdef VECTOR_FIELD_ subroutine MPP_UPDATE_NEST_FINE_2D_V_(fieldx, fieldy, nest_domain, wbufferx, wbuffery, sbufferx, sbuffery, & ebufferx, ebuffery, nbufferx, nbuffery, nest_level, & - flags, gridtype, complete, extra_halo, domain_name, tile_count) + flags, gridtype, complete, extra_halo, name, tile_count) MPP_TYPE_, intent(in) :: fieldx(:,:), fieldy(:,:) !< field x and y components on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data !! between fine and coarse grid. @@ -282,7 +282,7 @@ subroutine MPP_UPDATE_NEST_FINE_2D_V_(fieldx, fieldy, nest_domain, wbufferx, wbu integer, intent(in), optional :: extra_halo !< extra halo for passing data !! from coarse grid to fine grid. !! Default is 0 and currently only support extra_halo = 0. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain. + character(len=*), intent(in), optional :: name !< Name of the nest domain. integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -320,13 +320,13 @@ subroutine MPP_UPDATE_NEST_FINE_2D_V_(fieldx, fieldy, nest_domain, wbufferx, wbu call MPP_UPDATE_NEST_FINE_3D_V_(field3Dx, field3Dy, nest_domain, wbuffer3Dx, wbuffer3Dy, sbuffer3Dx, sbuffer3Dy, & ebuffer3Dx, ebuffer3Dy, nbuffer3Dx, nbuffer3Dy, nest_level, & - flags, gridtype, complete, extra_halo, domain_name, tile_count) + flags, gridtype, complete, extra_halo, name, tile_count) end subroutine MPP_UPDATE_NEST_FINE_2D_V_ subroutine MPP_UPDATE_NEST_FINE_3D_V_(fieldx, fieldy, nest_domain, wbufferx, wbuffery, sbufferx, sbuffery, & ebufferx, ebuffery, nbufferx, nbuffery, nest_level, & - flags, gridtype, complete, extra_halo, domain_name, tile_count) + flags, gridtype, complete, extra_halo, name, tile_count) MPP_TYPE_, intent(in) :: fieldx(:,:,:), fieldy(:,:,:) !< field x and y components !! on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data @@ -348,7 +348,7 @@ subroutine MPP_UPDATE_NEST_FINE_3D_V_(fieldx, fieldy, nest_domain, wbufferx, wbu integer, intent(in), optional :: extra_halo !< extra halo for passing data !! from coarse grid to fine grid. !! Default is 0 and currently only support extra_halo = 0. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain. + character(len=*), intent(in), optional :: name !< Name of the nest domain. integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -555,7 +555,7 @@ end subroutine MPP_UPDATE_NEST_FINE_3D_V_ subroutine MPP_UPDATE_NEST_FINE_4D_V_(fieldx, fieldy, nest_domain, wbufferx, wbuffery, sbufferx, sbuffery, & ebufferx, ebuffery, nbufferx, nbuffery, nest_level, & - flags, gridtype, complete, extra_halo, domain_name, tile_count) + flags, gridtype, complete, extra_halo, name, tile_count) MPP_TYPE_, intent(in) :: fieldx(:,:,:,:), fieldy(:,:,:,:) !< field x and y !! components on the model grid type(nest_domain_type), intent(inout) :: nest_domain @@ -580,7 +580,7 @@ subroutine MPP_UPDATE_NEST_FINE_4D_V_(fieldx, fieldy, nest_domain, wbufferx, wbu integer, intent(in), optional :: extra_halo !< extra halo for passing data !! from coarse grid to fine grid. !! Default is 0 and currently only support extra_halo = 0. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain. + character(len=*), intent(in), optional :: name !< Name of the nest domain. integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -617,13 +617,13 @@ subroutine MPP_UPDATE_NEST_FINE_4D_V_(fieldx, fieldy, nest_domain, wbufferx, wbu call MPP_UPDATE_NEST_FINE_3D_V_(field3Dx, field3Dy, nest_domain, wbuffer3Dx, wbuffer3Dy, sbuffer3Dx, sbuffer3Dy, & ebuffer3Dx, ebuffer3Dy, nbuffer3Dx, nbuffer3Dy, nest_level, & - flags, gridtype, complete, extra_halo, domain_name, tile_count) + flags, gridtype, complete, extra_halo, name, tile_count) end subroutine MPP_UPDATE_NEST_FINE_4D_V_ #endif -subroutine MPP_UPDATE_NEST_COARSE_2D_(field_in, nest_domain, field_out, nest_level, complete, position, domain_name, & +subroutine MPP_UPDATE_NEST_COARSE_2D_(field_in, nest_domain, field_out, nest_level, complete, position, name, & & tile_count) MPP_TYPE_, intent(in) :: field_in(:,:) !< field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data @@ -634,7 +634,7 @@ subroutine MPP_UPDATE_NEST_COARSE_2D_(field_in, nest_domain, field_out, nest_lev !! Default value is .true. integer, intent(in), optional :: position !< Cell position. Its value should be CENTER, EAST, CORNER !! or NORTH. Default is CENTER. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain optional argument + character(len=*), intent(in), optional :: name !< Name of the nest domain optional argument integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -644,7 +644,7 @@ subroutine MPP_UPDATE_NEST_COARSE_2D_(field_in, nest_domain, field_out, nest_lev pointer( ptr_out, field3D_out) ptr_in = LOC(field_in) ptr_out = LOC(field_out) - call mpp_update_nest_coarse( field3D_in, nest_domain, field3D_out, nest_level, complete, position, domain_name, & + call mpp_update_nest_coarse( field3D_in, nest_domain, field3D_out, nest_level, complete, position, name, & & tile_count) return @@ -655,7 +655,7 @@ end subroutine MPP_UPDATE_NEST_COARSE_2D_ !--- field_in is the data on fine grid pelist to be passed to coarse grid pelist. !--- field_in and field_out are all on the coarse grid. field_in is remapped from fine grid to coarse grid. -subroutine MPP_UPDATE_NEST_COARSE_3D_(field_in, nest_domain, field_out, nest_level, complete, position, domain_name, & +subroutine MPP_UPDATE_NEST_COARSE_3D_(field_in, nest_domain, field_out, nest_level, complete, position, name, & & tile_count) MPP_TYPE_, intent(in) :: field_in(:,:,:) !< field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data @@ -665,7 +665,7 @@ subroutine MPP_UPDATE_NEST_COARSE_3D_(field_in, nest_domain, field_out, nest_lev logical, intent(in), optional :: complete !< When .true., do the buffer filling. Default value is .true. integer, intent(in), optional :: position !< Cell position. Its value should be CENTER, EAST, CORNER, !! or NORTH. Default is CENTER. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain optional argument + character(len=*), intent(in), optional :: name !< Name of the nest domain optional argument integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -764,7 +764,7 @@ subroutine MPP_UPDATE_NEST_COARSE_3D_(field_in, nest_domain, field_out, nest_lev end subroutine MPP_UPDATE_NEST_COARSE_3D_ !############################################################################### -subroutine MPP_UPDATE_NEST_COARSE_4D_(field_in, nest_domain, field_out, nest_level, complete, position, domain_name, & +subroutine MPP_UPDATE_NEST_COARSE_4D_(field_in, nest_domain, field_out, nest_level, complete, position, name, & & tile_count) MPP_TYPE_, intent(in) :: field_in(:,:,:,:) !< field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data @@ -774,7 +774,7 @@ subroutine MPP_UPDATE_NEST_COARSE_4D_(field_in, nest_domain, field_out, nest_lev logical, intent(in), optional :: complete !< When .true., do the buffer filling. Default value is .true. integer, intent(in), optional :: position !< Cell position. Its value should be CENTER, EAST, CORNER, !! or NORTH. Default is CENTER. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain optional argument + character(len=*), intent(in), optional :: name !< Name of the nest domain optional argument integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -784,7 +784,7 @@ subroutine MPP_UPDATE_NEST_COARSE_4D_(field_in, nest_domain, field_out, nest_lev pointer( ptr_out, field3D_out ) ptr_in = LOC(field_in) ptr_out = LOC(field_out) - call mpp_update_nest_coarse( field3D_in, nest_domain, field3D_out, nest_level, complete, position, domain_name, & + call mpp_update_nest_coarse( field3D_in, nest_domain, field3D_out, nest_level, complete, position, name, & & tile_count) return @@ -797,7 +797,7 @@ end subroutine MPP_UPDATE_NEST_COARSE_4D_ !--- field_in is the data on fine grid pelist to be passed to coarse grid pelist. !--- field_in and field_out are all on the coarse grid. field_in is remapped from fine grid to coarse grid. subroutine MPP_UPDATE_NEST_COARSE_2D_V_(fieldx_in, fieldy_in, nest_domain, fieldx_out, fieldy_out, nest_level, & - flags, gridtype, complete, domain_name, tile_count) + flags, gridtype, complete, name, tile_count) MPP_TYPE_, intent(in) :: fieldx_in(:,:) !< x component of field on the model grid MPP_TYPE_, intent(in) :: fieldy_in(:,:) !< y component of field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data @@ -811,7 +811,7 @@ subroutine MPP_UPDATE_NEST_COARSE_2D_V_(fieldx_in, fieldy_in, nest_domain, field !! filled with data on coarse grid integer, intent(in) :: nest_level !< level of the nest (> 1 implies a telescoping nest) logical, intent(in), optional :: complete !< When .true., do the buffer filling. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain optional argument + character(len=*), intent(in), optional :: name !< Name of the nest domain optional argument integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -830,7 +830,7 @@ subroutine MPP_UPDATE_NEST_COARSE_2D_V_(fieldx_in, fieldy_in, nest_domain, field ptry_out = LOC(fieldy_out) call MPP_UPDATE_NEST_COARSE_3D_V_(field3Dx_in, field3Dy_in, nest_domain, field3Dx_out, field3Dy_out, & - nest_level, flags, gridtype, complete, domain_name, tile_count) + nest_level, flags, gridtype, complete, name, tile_count) end subroutine MPP_UPDATE_NEST_COARSE_2D_V_ @@ -838,7 +838,7 @@ end subroutine MPP_UPDATE_NEST_COARSE_2D_V_ !--- field_in is the data on fine grid pelist to be passed to coarse grid pelist. !--- field_in and field_out are all on the coarse grid. field_in is remapped from fine grid to coarse grid. subroutine MPP_UPDATE_NEST_COARSE_3D_V_(fieldx_in, fieldy_in, nest_domain, fieldx_out, fieldy_out, nest_level, & - flags, gridtype, complete, domain_name, tile_count) + flags, gridtype, complete, name, tile_count) MPP_TYPE_, intent(in) :: fieldx_in(:,:,:) !< x component field on the model grid MPP_TYPE_, intent(in) :: fieldy_in(:,:,:) !< y component of field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data @@ -852,7 +852,7 @@ subroutine MPP_UPDATE_NEST_COARSE_3D_V_(fieldx_in, fieldy_in, nest_domain, field !! filled with data on coarse grid integer, intent(in) :: nest_level !< level of the nest (> 1 implies a telescoping nest) logical, intent(in), optional :: complete !< When .true., do the buffer filling. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain optional argument + character(len=*), intent(in), optional :: name !< Name of the nest domain optional argument integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -1023,7 +1023,7 @@ subroutine MPP_UPDATE_NEST_COARSE_3D_V_(fieldx_in, fieldy_in, nest_domain, field end subroutine MPP_UPDATE_NEST_COARSE_3D_V_ subroutine MPP_UPDATE_NEST_COARSE_4D_V_(fieldx_in, fieldy_in, nest_domain, fieldx_out, fieldy_out, nest_level, & - flags, gridtype, complete, domain_name, tile_count) + flags, gridtype, complete, name, tile_count) MPP_TYPE_, intent(in) :: fieldx_in(:,:,:,:) !< x component field on the model grid MPP_TYPE_, intent(in) :: fieldy_in(:,:,:,:) !< y component field on the model grid type(nest_domain_type), intent(inout) :: nest_domain !< Holds the information to pass data @@ -1037,7 +1037,7 @@ subroutine MPP_UPDATE_NEST_COARSE_4D_V_(fieldx_in, fieldy_in, nest_domain, field !! filled with data on coarse grid integer, intent(in) :: nest_level !< level of the nest (> 1 implies a telescoping nest) logical, intent(in), optional :: complete !< When .true., do the buffer filling. - character(len=*), intent(in), optional :: domain_name !< Name of the nest domain optional argument + character(len=*), intent(in), optional :: name !< Name of the nest domain optional argument integer, intent(in), optional :: tile_count !< Used to support multiple-tile-per-pe. !! default is 1 and currently only support tile_count = 1. @@ -1056,7 +1056,7 @@ subroutine MPP_UPDATE_NEST_COARSE_4D_V_(fieldx_in, fieldy_in, nest_domain, field ptry_out = LOC(fieldy_out) call MPP_UPDATE_NEST_COARSE_3D_V_(field3Dx_in, field3Dy_in, nest_domain, field3Dx_out, field3Dy_out, & - nest_level, flags, gridtype, complete, domain_name, tile_count) + nest_level, flags, gridtype, complete, name, tile_count) end subroutine MPP_UPDATE_NEST_COARSE_4D_V_ diff --git a/mpp/include/mpp_util.inc b/mpp/include/mpp_util.inc index 38c4de1e77..ea08bd53ab 100644 --- a/mpp/include/mpp_util.inc +++ b/mpp/include/mpp_util.inc @@ -428,15 +428,15 @@ end function rarray_to_char !! !! This call implies synchronization across the PEs in the current !! pelist, of which pelist is a subset. - subroutine mpp_declare_pelist( pelist, pelist_name ) + subroutine mpp_declare_pelist( pelist, name ) integer, intent(in) :: pelist(:) - character(len=*), intent(in), optional :: pelist_name + character(len=*), intent(in), optional :: name integer :: i if( .NOT.module_is_initialized )call mpp_error( FATAL, 'MPP_DECLARE_PELIST: You must first call mpp_init.' ) i = get_peset(pelist) write( peset(i)%pelist_name,'(a,i2.2)' ) 'PElist', i !default name - if( PRESENT(pelist_name) )peset(i)%pelist_name = pelist_name + if( PRESENT(name) )peset(i)%pelist_name = name return end subroutine mpp_declare_pelist @@ -489,15 +489,15 @@ end function rarray_to_char !##################################################################### !this is created for use by mpp_define_domains within a pelist !will be published but not publicized - subroutine mpp_get_current_pelist( pelist, pelist_name, commID ) + subroutine mpp_get_current_pelist( pelist, name, commID ) integer, intent(out) :: pelist(:) - character(len=*), intent(out), optional :: pelist_name + character(len=*), intent(out), optional :: name integer, intent(out), optional :: commID if( size(pelist(:)).NE.size(peset(current_peset_num)%list(:)) ) & call mpp_error( FATAL, 'MPP_GET_CURRENT_PELIST: size(pelist) is wrong.' ) pelist(:) = peset(current_peset_num)%list(:) - if( PRESENT(pelist_name) )pelist_name = peset(current_peset_num)%pelist_name + if( PRESENT(name) )name = peset(current_peset_num)%pelist_name #ifdef use_libMPI if( PRESENT(commID) )commID = peset(current_peset_num)%id #endif diff --git a/test_fms/coupler/test_coupler_2d.F90 b/test_fms/coupler/test_coupler_2d.F90 index a98ff8353d..7e954be756 100644 --- a/test_fms/coupler/test_coupler_2d.F90 +++ b/test_fms/coupler/test_coupler_2d.F90 @@ -63,7 +63,7 @@ program test_coupler_2d nlat=60 nlon=60 -call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, domain_name='test_coupler') +call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_coupler') call mpp_define_io_domain(Domain, (/1,1/)) call mpp_get_data_domain(Domain, data_grid(1), data_grid(2), data_grid(3), data_grid(4)) diff --git a/test_fms/coupler/test_coupler_3d.F90 b/test_fms/coupler/test_coupler_3d.F90 index ec0c007fa8..dd1d481c51 100644 --- a/test_fms/coupler/test_coupler_3d.F90 +++ b/test_fms/coupler/test_coupler_3d.F90 @@ -66,7 +66,7 @@ program test_coupler_3d call mpp_domains_set_stack_size( 72000) -call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, domain_name='test_coupler') +call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_coupler') call mpp_define_io_domain(Domain, (/1,1/)) call mpp_get_data_domain(Domain, data_grid(1), data_grid(2), data_grid(3), data_grid(4)) diff --git a/test_fms/coupler/test_coupler_types.F90 b/test_fms/coupler/test_coupler_types.F90 index 0f5f77f912..8bd8a5af4c 100644 --- a/test_fms/coupler/test_coupler_types.F90 +++ b/test_fms/coupler/test_coupler_types.F90 @@ -81,7 +81,7 @@ program test_coupler_types nlat=60; nlon=60; nz=12 layout = (/2, 2/) call mpp_domains_set_stack_size(86400) -call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, domain_name='test_coupler') +call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_coupler') call mpp_define_io_domain(Domain, (/1,1/)) call mpp_get_data_domain(Domain, data_grid(1), data_grid(2), data_grid(3), data_grid(4)) @@ -249,7 +249,7 @@ program test_coupler_types ! coupler_type_redistribute_data ! just using the same domain -call mpp_define_domains((/1, nlon, 1, nlat/), layout, Domain_out, domain_name="test_coupler_redistributed_2x2") +call mpp_define_domains((/1, nlon, 1, nlat/), layout, Domain_out, name="test_coupler_redistributed_2x2") call set_up_2d_coupler_type(bc_2d_cp, data_grid, appendix="new", to_read=.false.) call set_up_3d_coupler_type(bc_3d_cp, data_grid, appendix="new", to_read=.false.) call coupler_type_redistribute_data(bc_2d_new, Domain, bc_2d_cp, domain_out, complete=.true.) @@ -257,7 +257,7 @@ program test_coupler_types call coupler_type_destructor(bc_2d_cp) call coupler_type_destructor(bc_3d_cp) ! using a different layout -call mpp_define_domains((/1, nlon, 1, nlat/), (/1, 4/), Domain_out, domain_name="test_coupler_redistributed_1x4") +call mpp_define_domains((/1, nlon, 1, nlat/), (/1, 4/), Domain_out, name="test_coupler_redistributed_1x4") call mpp_get_data_domain(Domain_out, data_grid(1), data_grid(2), data_grid(3), data_grid(4)) call set_up_2d_coupler_type(bc_2d_cp, data_grid, appendix="new", to_read=.false.) call set_up_3d_coupler_type(bc_3d_cp, data_grid, appendix="new", to_read=.false.) diff --git a/test_fms/data_override/test_data_override.F90 b/test_fms/data_override/test_data_override.F90 index 1f28d008e0..4b4c3650ba 100644 --- a/test_fms/data_override/test_data_override.F90 +++ b/test_fms/data_override/test_data_override.F90 @@ -173,7 +173,7 @@ program test end if - call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, domain_name='test_data_override') + call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_data_override') call mpp_define_io_domain(Domain, (/1,1/)) call data_override_init(Ice_domain_in=Domain, Ocean_domain_in=Domain, mode=lkind) call data_override_init(Ice_domain_in=Domain, Ocean_domain_in=Domain, mode=lkind) @@ -554,7 +554,7 @@ subroutine test_unstruct_grid( type, Time ) ntiles_grid = 1 !--- define the unstructured grid domain call mpp_define_unstruct_domain(UG_domain, SG_domain, npts_tile, ntiles_grid, mpp_npes(), 1, grid_index, & - & domain_name="LAND unstruct") + & name="LAND unstruct") call mpp_get_UG_compute_domain(UG_domain, istart, iend) !--- figure out lmask according to grid_index @@ -834,7 +834,7 @@ subroutine define_cubic_mosaic(type, domain, ni, nj, global_indices, layout, pe_ call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, symmetry = .true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name = trim(type), memory_size = msize ) + shalo=shalo, nhalo=nhalo, name = trim(type), memory_size = msize ) return diff --git a/test_fms/data_override/test_data_override_ongrid.F90 b/test_fms/data_override/test_data_override_ongrid.F90 index 358c52f815..3f031547fa 100644 --- a/test_fms/data_override/test_data_override_ongrid.F90 +++ b/test_fms/data_override/test_data_override_ongrid.F90 @@ -136,7 +136,7 @@ program test_data_override_ongrid !< Create a domain nlonXnlat with mask call mpp_domains_set_stack_size(17280000) -call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, xhalo=nhalox, yhalo=nhaloy, domain_name='test_data_override_emc') +call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, xhalo=nhalox, yhalo=nhaloy, name='test_data_override_emc') call mpp_define_io_domain(Domain, (/1,1/)) call mpp_get_data_domain(Domain, is, ie, js, je) diff --git a/test_fms/data_override/test_get_grid_v1.F90 b/test_fms/data_override/test_get_grid_v1.F90 index f50b7886a1..d1c1fa755f 100644 --- a/test_fms/data_override/test_get_grid_v1.F90 +++ b/test_fms/data_override/test_get_grid_v1.F90 @@ -81,7 +81,7 @@ program test_get_grid_v1 nlat = 1 !< Create a domain -call mpp_define_domains( (/1,nlon,1,nlat/), (/1, 1/), Domain, domain_name='Atm') +call mpp_define_domains( (/1,nlon,1,nlat/), (/1, 1/), Domain, name='Atm') call mpp_define_io_domain(Domain, (/1,1/)) call mpp_get_compute_domain(Domain,is,ie,js,je) diff --git a/test_fms/diag_manager/test_diag_manager.F90 b/test_fms/diag_manager/test_diag_manager.F90 index 6632e460a1..dd263d2e3f 100644 --- a/test_fms/diag_manager/test_diag_manager.F90 +++ b/test_fms/diag_manager/test_diag_manager.F90 @@ -442,7 +442,7 @@ PROGRAM test nlon2 = nlon * 2 nlat2 = nlat * 2 - CALL mpp_define_domains((/1,nlon1,1,nlat1/), layout, Domain1, domain_name='test_diag_manager') + CALL mpp_define_domains((/1,nlon1,1,nlat1/), layout, Domain1, name='test_diag_manager') CALL mpp_get_compute_domain(Domain1, is1, ie1, js1, je1) ALLOCATE(lon_global1(nlon1), lonb_global1(nlon1+1)) ALLOCATE(lat_global1(nlat1), latb_global1(nlat1+1)) @@ -453,7 +453,7 @@ PROGRAM test ALLOCATE(lon1(is1:ie1), lat1(js1:je1), lonb1(is1:ie1+1), latb1(js1:je1+1)) CALL compute_grid(nlon1, nlat1, is1, ie1, js1, je1, lon_global1, lat_global1, lonb_global1, latb_global1, lon1, & & lat1, lonb1, latb1) - CALL mpp_define_domains((/1,nlon2,1,nlat2/), layout, Domain2, domain_name='test_diag_manager') + CALL mpp_define_domains((/1,nlon2,1,nlat2/), layout, Domain2, name='test_diag_manager') CALL mpp_get_compute_domain(Domain2, is2, ie2, js2, je2) CALL mpp_define_io_domain(Domain1, io_layout) CALL mpp_define_io_domain(Domain2, io_layout) diff --git a/test_fms/diag_manager/test_diag_manager_time.F90 b/test_fms/diag_manager/test_diag_manager_time.F90 index 3dc3bedec5..e95fdbfc1d 100644 --- a/test_fms/diag_manager/test_diag_manager_time.F90 +++ b/test_fms/diag_manager/test_diag_manager_time.F90 @@ -52,7 +52,7 @@ program test_diag_manager_time nz = 5 call mpp_domains_set_stack_size(17280000) -call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, domain_name='test_diag_manager') +call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_diag_manager') call mpp_define_io_domain(Domain, (/1,1/)) call mpp_get_compute_domain(Domain, is, ie, js, je) diff --git a/test_fms/exchange/test_xgrid.F90 b/test_fms/exchange/test_xgrid.F90 index 6a878ee905..e28cab347d 100644 --- a/test_fms/exchange/test_xgrid.F90 +++ b/test_fms/exchange/test_xgrid.F90 @@ -222,15 +222,15 @@ program xgrid_test if( atm_layout(1)*atm_layout(2) .NE. npes ) then call mpp_define_layout( (/1,atm_nx,1,atm_ny/), npes, atm_layout) endif - call mpp_define_domains( (/1,atm_nx,1,atm_ny/), atm_layout, Atm_domain, domain_name="atmosphere") + call mpp_define_domains( (/1,atm_nx,1,atm_ny/), atm_layout, Atm_domain, name="atmosphere") if( lnd_layout(1)*lnd_layout(2) .NE. npes ) then call mpp_define_layout( (/1,lnd_nx,1,lnd_ny/), npes, lnd_layout) endif - call mpp_define_domains( (/1,lnd_nx,1,lnd_ny/), lnd_layout, Lnd_domain, domain_name="land") + call mpp_define_domains( (/1,lnd_nx,1,lnd_ny/), lnd_layout, Lnd_domain, name="land") if( ice_layout(1)*ice_layout(2) .NE. npes ) then call mpp_define_layout( (/1,ice_nx,1,ice_ny/), npes, ice_layout) endif - call mpp_define_domains( (/1,ice_nx,1,ice_ny/), ice_layout, Ice_domain, domain_name="Ice") + call mpp_define_domains( (/1,ice_nx,1,ice_ny/), ice_layout, Ice_domain, name="Ice") else if (variable_exists(gridfileobj, "atm_mosaic" ) ) then !--- Get the mosaic data of each component model @@ -323,7 +323,7 @@ program xgrid_test istart2(1:ncontact_global), iend2(1:ncontact_global), & jstart2(1:ncontact_global), jend2(1:ncontact_global), & pe_start, pe_end, whalo=1, ehalo=1, shalo=1, nhalo=1, & - tile_id=tile_id, domain_name="atmosphere") + tile_id=tile_id, name="atmosphere") call mpp_define_io_domain(Atm_domain, (/1,1/)) deallocate( pe_start, pe_end, global_indices, layout, tile_id ) endif @@ -347,7 +347,7 @@ program xgrid_test tile_id(1) = ntile_atm call mpp_define_mosaic(global_indices, layout, Atm_domain, ntile_atm_nest, ncontact, dummy, dummy, & dummy, dummy, dummy, dummy, dummy, dummy, dummy, dummy, pe_start, pe_end, & - whalo=1, ehalo=1, shalo=1, nhalo=1, tile_id=tile_id, domain_name="atmos nest") + whalo=1, ehalo=1, shalo=1, nhalo=1, tile_id=tile_id, name="atmos nest") call mpp_define_io_domain(Atm_domain, (/1,1/)) deallocate( pe_start, pe_end, global_indices, layout, tile_id ) @@ -379,7 +379,7 @@ program xgrid_test enddo call mpp_define_mosaic(global_indices, layout, Lnd_domain, ntile_lnd, ncontact, dummy, dummy, & - dummy, dummy, dummy, dummy, dummy, dummy, dummy, dummy, pe_start, pe_end, tile_id=tile_id, domain_name="land") + dummy, dummy, dummy, dummy, dummy, dummy, dummy, dummy, pe_start, pe_end, tile_id=tile_id, name="land") call mpp_define_io_domain(Lnd_domain, (/1,1/)) deallocate( pe_start, pe_end, global_indices, layout, tile_id ) @@ -407,7 +407,7 @@ program xgrid_test enddo call mpp_define_mosaic(global_indices, layout, Ice_domain, ntile_ice, ncontact, dummy, dummy, & - dummy, dummy, dummy, dummy, dummy, dummy, dummy, dummy, pe_start, pe_end, tile_id=tile_id, domain_name="Ice") + dummy, dummy, dummy, dummy, dummy, dummy, dummy, dummy, pe_start, pe_end, tile_id=tile_id, name="Ice") call mpp_define_io_domain(Ice_domain, (/1,1/)) deallocate( pe_start, pe_end, global_indices, layout, tile_id ) @@ -851,7 +851,7 @@ subroutine test_unstruct_exchange() if(lnd_pe) then call mpp_set_current_pelist(lnd_pelist) call mpp_define_unstruct_domain(UG_domain, Lnd_domain, npts_tile, ntiles_grid, mpp_npes(), & - 1, grid_index, domain_name="LAND unstruct") + 1, grid_index, name="LAND unstruct") call mpp_get_UG_compute_domain(UG_domain, is_ug, ie_ug) endif call mpp_set_current_pelist() diff --git a/test_fms/fms2_io/create_atmosphere_domain.inc b/test_fms/fms2_io/create_atmosphere_domain.inc index c660e46304..cb926551d4 100644 --- a/test_fms/fms2_io/create_atmosphere_domain.inc +++ b/test_fms/fms2_io/create_atmosphere_domain.inc @@ -222,6 +222,6 @@ subroutine create_atmosphere_domain(ni, nj, global_indices, layout, pe_start, pe tile2, istart1, iend1, jstart1, jend1, istart2, iend2, & jstart2, jend2, pe_start, pe_end, symmetry = .true., & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name=trim("Cubed-sphere"), memory_size=msize) + name=trim("Cubed-sphere"), memory_size=msize) call mpp_define_io_domain(domain, io_layout) end subroutine create_atmosphere_domain diff --git a/test_fms/fms2_io/create_land_domain.inc b/test_fms/fms2_io/create_land_domain.inc index 7fa68955ba..e8a18f9fc5 100644 --- a/test_fms/fms2_io/create_land_domain.inc +++ b/test_fms/fms2_io/create_land_domain.inc @@ -100,7 +100,7 @@ subroutine create_land_domain(atmos_domain, nx, ny, ntiles, land_domain, npes_gr allocate(ntiles_grid(ntotal_land)) ntiles_grid = 1 call mpp_define_unstruct_domain(land_domain, atmos_domain, npts_tile, ntiles_grid, & - mpp_npes(), npes_group, grid_index, domain_name="Unstructured domain") + mpp_npes(), npes_group, grid_index, name="Unstructured domain") deallocate(npts_tile) deallocate(grid_index) deallocate(ntiles_grid) diff --git a/test_fms/fms2_io/create_ocean_domain.inc b/test_fms/fms2_io/create_ocean_domain.inc index 63405b9f9b..447286d38c 100644 --- a/test_fms/fms2_io/create_ocean_domain.inc +++ b/test_fms/fms2_io/create_ocean_domain.inc @@ -40,6 +40,6 @@ subroutine create_ocean_domain(nx, ny, npes, domain, layout, io_layout) nhalo = whalo call mpp_define_domains((/1,nx,1,ny/), layout, domain, xflags=CYCLIC_GLOBAL_DOMAIN, & yflags=FOLD_NORTH_EDGE, whalo=whalo, ehalo=ehalo, shalo=shalo, & - nhalo=nhalo, symmetry=.true., domain_name="Tripolar Folded North Symmetry") + nhalo=nhalo, symmetry=.true., name="Tripolar Folded North Symmetry") call mpp_define_io_domain(domain, io_layout) end subroutine create_ocean_domain diff --git a/test_fms/fms2_io/setup.F90 b/test_fms/fms2_io/setup.F90 index 4ea296debb..a4ab44589e 100644 --- a/test_fms/fms2_io/setup.F90 +++ b/test_fms/fms2_io/setup.F90 @@ -377,7 +377,7 @@ subroutine create_cubed_sphere_domain(test_params, domain, io_layout) num_contact, tile1, tile2, istart1, iend1, jstart1, jend1, & istart2, iend2, jstart2, jend2, test_params%pe_start, & test_params%pe_end, symmetry=.true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=trim("Cubed-sphere"), & + shalo=shalo, nhalo=nhalo, name=trim("Cubed-sphere"), & memory_size=msize) call mpp_define_io_domain(domain, io_layout) end subroutine create_cubed_sphere_domain @@ -465,7 +465,7 @@ subroutine create_unstructured_domain(cubed_sphere_domain, test_params, unstruct ntiles_grid = 1 call mpp_define_unstruct_domain(unstructured_domain, cubed_sphere_domain, npts_tile, ntiles_grid, & mpp_npes(), test_params%npes_group, grid_index, & - domain_name="Unstructured domain") + name="Unstructured domain") deallocate(npts_tile) deallocate(grid_index) deallocate(ntiles_grid) @@ -490,7 +490,7 @@ subroutine create_tripolar_domain(test_params, domain) call mpp_define_domains((/1,test_params%nx,1,test_params%ny/), test_params%layout(:,1), & domain, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - symmetry=.true., domain_name="Tripolar Folded North Symmetry") + symmetry=.true., name="Tripolar Folded North Symmetry") call mpp_define_io_domain(domain, test_params%io_layout) end subroutine create_tripolar_domain diff --git a/test_fms/fms2_io/test_bc_restart.F90 b/test_fms/fms2_io/test_bc_restart.F90 index dd5a586259..f863284984 100644 --- a/test_fms/fms2_io/test_bc_restart.F90 +++ b/test_fms/fms2_io/test_bc_restart.F90 @@ -68,7 +68,7 @@ program test_bc_restart nlat = 144 call mpp_define_domains( (/1,nlon,1,nlat/), layout, atm%Domain, xhalo=3, yhalo=3, symmetry=.true., & - & domain_name='test_bc_restart') + & name='test_bc_restart') call mpp_get_data_domain(atm%domain, isd, ied, jsd, jed ) allocate(atm%var2d(isd:ied,jsd:jed)) diff --git a/test_fms/fms2_io/test_io_with_mask.F90 b/test_fms/fms2_io/test_io_with_mask.F90 index 437eb933e2..d5789fafc1 100644 --- a/test_fms/fms2_io/test_io_with_mask.F90 +++ b/test_fms/fms2_io/test_io_with_mask.F90 @@ -70,7 +70,7 @@ program test_io_with_mask !< Create a domain nlonXnlat with mask call mpp_domains_set_stack_size(17280000) -call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, domain_name='test_io_with_mask', maskmap=parsed_mask) +call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_io_with_mask', maskmap=parsed_mask) call mpp_define_io_domain(Domain, (/1,1/)) call mpp_get_compute_domain(Domain, is, ie, js, je) diff --git a/test_fms/mosaic2/test_grid2.F90 b/test_fms/mosaic2/test_grid2.F90 index e21d6a8985..3f008badb2 100644 --- a/test_fms/mosaic2/test_grid2.F90 +++ b/test_fms/mosaic2/test_grid2.F90 @@ -174,7 +174,7 @@ subroutine test_get_grid_cell_area_ug !> The unstructured grid is the same as the structured grid; there's only one center point in the tile. call mpp_define_domains((/1,1,1,1/), (/1,1/), SG_domain) call mpp_define_unstruct_domain(UG_domain, SG_domain,npts_tile,grid_nlevel,& - mpp_npes(),ndivs,grid_index,domain_name='immadeup') + mpp_npes(),ndivs,grid_index,name='immadeup') !> The area computed by get_grid_cell_area is for the entire cell !! The array area, set in write_files.F90, is the area for 1/4th of the cell diff --git a/test_fms/mpp/test_domains_utility_mod.F90 b/test_fms/mpp/test_domains_utility_mod.F90 index ff63c13e82..65926016ed 100644 --- a/test_fms/mpp/test_domains_utility_mod.F90 +++ b/test_fms/mpp/test_domains_utility_mod.F90 @@ -369,12 +369,12 @@ subroutine define_cubic_mosaic(type, domain, ni, nj, global_indices, layout, pe_ call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, symmetry = .true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name = trim(type), memory_size = msize ) + shalo=shalo, nhalo=nhalo, name = trim(type), memory_size = msize ) else call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, symmetry = .true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name = trim(type) ) + shalo=shalo, nhalo=nhalo, name = trim(type) ) endif return @@ -451,7 +451,7 @@ subroutine define_fourtile_mosaic(type, domain, ni, nj, global_indices, layout, call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, memory_size = msize, symmetry = symmetry ) + name = type, memory_size = msize, symmetry = symmetry ) return diff --git a/test_fms/mpp/test_global_arrays.F90 b/test_fms/mpp/test_global_arrays.F90 index 6e4f9b834a..4f27b0c666 100644 --- a/test_fms/mpp/test_global_arrays.F90 +++ b/test_fms/mpp/test_global_arrays.F90 @@ -545,13 +545,13 @@ subroutine test_global_reduce (type) select case(type) case( 'Simple' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Simple symmetry center', 'Simple symmetry corner', 'Simple symmetry east', 'Simple symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case( 'Cyclic symmetry center', 'Cyclic symmetry corner', 'Cyclic symmetry east', 'Cyclic symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo,& - domain_name=type, symmetry = .true., xflags=CYCLIC_GLOBAL_DOMAIN, & + name=type, symmetry = .true., xflags=CYCLIC_GLOBAL_DOMAIN, & & yflags=CYCLIC_GLOBAL_DOMAIN ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) diff --git a/test_fms/mpp/test_mpp_domains.F90 b/test_fms/mpp/test_mpp_domains.F90 index 81e221d9fe..5189288507 100644 --- a/test_fms/mpp/test_mpp_domains.F90 +++ b/test_fms/mpp/test_mpp_domains.F90 @@ -405,7 +405,7 @@ subroutine test_redistribute( type ) case( 'Complete pelist' ) !set up x array call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) - call mpp_define_domains( (/1,nx,1,ny/), layout, domainx, domain_name=type ) + call mpp_define_domains( (/1,nx,1,ny/), layout, domainx, name=type ) call mpp_get_compute_domain( domainx, is, ie, js, je ) call mpp_get_data_domain ( domainx, isd, ied, jsd, jed ) allocate( x(isd:ied,jsd:jed,nz) ) @@ -418,7 +418,7 @@ subroutine test_redistribute( type ) x(is:ie,js:je,:) = global(is:ie,js:je,:) x2 = x; x3 = x; x4 = x; x5 = x; x6 = x !set up y array - call mpp_define_domains( (/1,nx,1,ny/), (/npes,1/), domainy, domain_name=type ) + call mpp_define_domains( (/1,nx,1,ny/), (/npes,1/), domainy, name=type ) call mpp_get_compute_domain( domainy, is, ie, js, je ) call mpp_get_data_domain ( domainy, isd, ied, jsd, jed ) allocate( y(isd:ied,jsd:jed,nz) ) @@ -433,7 +433,7 @@ subroutine test_redistribute( type ) !one pelist from 0...pemax, other from 0...npes-1 !set up x array call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) - call mpp_define_domains( (/1,nx,1,ny/), layout, domainx, domain_name=type ) + call mpp_define_domains( (/1,nx,1,ny/), layout, domainx, name=type ) call mpp_get_compute_domain( domainx, is, ie, js, je ) call mpp_get_data_domain ( domainx, isd, ied, jsd, jed ) allocate( x(isd:ied,jsd:jed,nz) ) @@ -449,7 +449,7 @@ subroutine test_redistribute( type ) if( ANY(pelist.EQ.pe) )then call mpp_set_current_pelist(pelist) call mpp_define_layout( (/1,nx,1,ny/), mpp_npes(), layout ) - call mpp_define_domains( (/1,nx,1,ny/), layout, domainy, domain_name=type ) + call mpp_define_domains( (/1,nx,1,ny/), layout, domainy, name=type ) call mpp_get_compute_domain( domainy, is, ie, js, je ) call mpp_get_data_domain ( domainy, isd, ied, jsd, jed ) allocate( y(isd:ied,jsd:jed,nz) ) @@ -468,7 +468,7 @@ subroutine test_redistribute( type ) if( ANY(pelist.EQ.pe) )then call mpp_set_current_pelist(pelist) call mpp_define_layout( (/1,nx,1,ny/), mpp_npes(), layout ) - call mpp_define_domains( (/1,nx,1,ny/), layout, domainy, domain_name=type ) + call mpp_define_domains( (/1,nx,1,ny/), layout, domainy, name=type ) call mpp_get_compute_domain( domainy, is, ie, js, je ) call mpp_get_data_domain ( domainy, isd, ied, jsd, jed ) allocate( y(isd:ied,jsd:jed,nz) ) @@ -483,7 +483,7 @@ subroutine test_redistribute( type ) !set up x array call mpp_set_current_pelist( (/ (i,i=pemax+1,npes-1) /) ) call mpp_define_layout( (/1,nx,1,ny/), mpp_npes(), layout ) - call mpp_define_domains( (/1,nx,1,ny/), layout, domainx, domain_name=type ) + call mpp_define_domains( (/1,nx,1,ny/), layout, domainx, name=type ) call mpp_get_compute_domain( domainx, is, ie, js, je ) call mpp_get_data_domain ( domainx, isd, ied, jsd, jed ) allocate( x(isd:ied,jsd:jed,nz) ) @@ -939,7 +939,7 @@ subroutine test_uniform_mosaic( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .false. ) + name = type, symmetry = .false. ) else if(folded_north) then !--- Contact line 1, between tile 1 (EAST) and tile 1 (WEST) --- cyclic tile1(1) = 1; tile2(1) = 1 @@ -953,12 +953,12 @@ subroutine test_uniform_mosaic( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .false. ) + name = type, symmetry = .false. ) else call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .true. ) + name = type, symmetry = .true. ) endif else if(folded_south_sym) then !--- Contact line 1, between tile 1 (EAST) and tile 1 (WEST) --- cyclic @@ -972,7 +972,7 @@ subroutine test_uniform_mosaic( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .true. ) + name = type, symmetry = .true. ) else if(folded_west_sym) then !--- Contact line 1, between tile 1 (NORTH) and tile 1 (SOUTH) --- cyclic tile1(1) = 1; tile2(1) = 1 @@ -985,7 +985,7 @@ subroutine test_uniform_mosaic( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .true. ) + name = type, symmetry = .true. ) else if(folded_east_sym) then !--- Contact line 1, between tile 1 (NORTH) and tile 1 (SOUTH) --- cyclic tile1(1) = 1; tile2(1) = 1 @@ -998,7 +998,7 @@ subroutine test_uniform_mosaic( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .true. ) + name = type, symmetry = .true. ) else if( four_tile ) then call define_fourtile_mosaic(type, domain, (/nx,nx,nx,nx/), (/ny,ny,ny,ny/), global_indices, & layout2D, pe_start, pe_end, symmetry = .false. ) @@ -1150,7 +1150,7 @@ subroutine test_uniform_mosaic( type ) write(type2,'(a,a,i2,a,i2,a,i2,a,i2)') trim(type), ' with whalo = ', wh, & ', ehalo = ',eh, ', shalo = ', sh, ', nhalo = ', nh - call mpp_update_domains( x, domain, whalo=wh, ehalo=eh, shalo=sh, nhalo=nh, str_name = type2 ) + call mpp_update_domains( x, domain, whalo=wh, ehalo=eh, shalo=sh, nhalo=nh, name = type2 ) call compare_checksums( x(isd:ied,jsd:jed,:,1), local2, trim(type2) ) end do end do @@ -1371,10 +1371,10 @@ subroutine test_uniform_mosaic( type ) if(ntile_per_pe > 1) write(type3, *)trim(type2), " at tile_count = ",n call mpp_clock_begin(id) if(ntile_per_pe == 1) then - call mpp_update_domains( x(:,:,:,n), y(:,:,:,n), domain, flags=update_flags, gridtype=BGRID_NE, str_name=type3) + call mpp_update_domains( x(:,:,:,n), y(:,:,:,n), domain, flags=update_flags, gridtype=BGRID_NE, name=type3) else call mpp_update_domains( x(:,:,:,n), y(:,:,:,n), domain, flags=update_flags, gridtype=BGRID_NE, & - str_name=type3, tile_count = n) + name=type3, tile_count = n) end if call mpp_clock_end (id) end do @@ -1389,10 +1389,10 @@ subroutine test_uniform_mosaic( type ) if(ntile_per_pe == 1) then call mpp_clock_begin(id) - call mpp_update_domains( x1, y1, domain, flags=update_flags, gridtype=BGRID_NE, complete=.false., str_name=type2) - call mpp_update_domains( x2, y2, domain, flags=update_flags, gridtype=BGRID_NE, complete=.false., str_name=type2) - call mpp_update_domains( x3, y3, domain, flags=update_flags, gridtype=BGRID_NE, complete=.false., str_name=type2) - call mpp_update_domains( x4, y4, domain, flags=update_flags, gridtype=BGRID_NE, complete=.true., str_name=type2) + call mpp_update_domains( x1, y1, domain, flags=update_flags, gridtype=BGRID_NE, complete=.false., name=type2) + call mpp_update_domains( x2, y2, domain, flags=update_flags, gridtype=BGRID_NE, complete=.false., name=type2) + call mpp_update_domains( x3, y3, domain, flags=update_flags, gridtype=BGRID_NE, complete=.false., name=type2) + call mpp_update_domains( x4, y4, domain, flags=update_flags, gridtype=BGRID_NE, complete=.true., name=type2) call mpp_clock_end (id) call compare_checksums( x1(isd:ied+shift,jsd:jed+shift,:,1), global1(isd:ied+shift,jsd:jed+shift,:,1), & @@ -1438,7 +1438,7 @@ subroutine test_uniform_mosaic( type ) write(type3,'(a,a,i2,a,i2,a,i2,a,i2)') trim(type2), ' with whalo = ', wh, & ', ehalo = ',eh, ', shalo = ', sh, ', nhalo = ', nh call mpp_update_domains( x, y, domain, flags=update_flags, gridtype=BGRID_NE, & - whalo=wh, ehalo=eh, shalo=sh, nhalo=nh, str_name=type3) + whalo=wh, ehalo=eh, shalo=sh, nhalo=nh, name=type3) call compare_checksums( x(isd:ied+shift,jsd:jed+shift,:,1), local1, trim(type3)//' X' ) call compare_checksums( y(isd:ied+shift,jsd:jed+shift,:,1), local2, trim(type3)//' Y' ) end do @@ -1573,10 +1573,10 @@ subroutine test_uniform_mosaic( type ) if(ntile_per_pe > 1) write(type2, *)type, " at tile_count = ",n call mpp_clock_begin(id) if(ntile_per_pe == 1) then - call mpp_update_domains( x(:,:,:,n), y(:,:,:,n), domain, gridtype=CGRID_NE, str_name=type2//' vector CGRID_NE') + call mpp_update_domains( x(:,:,:,n), y(:,:,:,n), domain, gridtype=CGRID_NE, name=type2//' vector CGRID_NE') else call mpp_update_domains( x(:,:,:,n), y(:,:,:,n), domain, gridtype=CGRID_NE, & - str_name=type2//' vector CGRID_NE', tile_count = n) + name=type2//' vector CGRID_NE', tile_count = n) end if call mpp_clock_end (id) end do @@ -1593,10 +1593,10 @@ subroutine test_uniform_mosaic( type ) if(ntile_per_pe == 1) then call mpp_clock_begin(id) - call mpp_update_domains( x1, y1, domain, gridtype=CGRID_NE, complete=.false., str_name=type//' vector CGRID_NE' ) - call mpp_update_domains( x2, y2, domain, gridtype=CGRID_NE, complete=.false., str_name=type//' vector CGRID_NE') - call mpp_update_domains( x3, y3, domain, gridtype=CGRID_NE, complete=.false., str_name=type//' vector CGRID_NE' ) - call mpp_update_domains( x4, y4, domain, gridtype=CGRID_NE, complete=.true. , str_name=type//' vector CGRID_NE') + call mpp_update_domains( x1, y1, domain, gridtype=CGRID_NE, complete=.false., name=type//' vector CGRID_NE' ) + call mpp_update_domains( x2, y2, domain, gridtype=CGRID_NE, complete=.false., name=type//' vector CGRID_NE') + call mpp_update_domains( x3, y3, domain, gridtype=CGRID_NE, complete=.false., name=type//' vector CGRID_NE' ) + call mpp_update_domains( x4, y4, domain, gridtype=CGRID_NE, complete=.true. , name=type//' vector CGRID_NE') call mpp_clock_end (id) call compare_checksums( x1(isd:ied+shift,jsd:jed,:,1), global1(isd:ied+shift,jsd:jed,:,1), type//' CGRID_NE X1') @@ -1631,7 +1631,7 @@ subroutine test_uniform_mosaic( type ) write(type3,'(a,a,i2,a,i2,a,i2,a,i2)') trim(type), ' vector CGRID_NE with whalo = ', & wh, ', ehalo = ',eh, ', shalo = ', sh, ', nhalo = ', nh call mpp_update_domains( x, y, domain, gridtype=CGRID_NE, whalo=wh, ehalo=eh, & - shalo=sh, nhalo=nh, str_name=type3) + shalo=sh, nhalo=nh, name=type3) call compare_checksums( x(isd:ied+shift,jsd:jed, :,1), local1, trim(type3)//' X' ) call compare_checksums( y(isd:ied,jsd:jed+shift, :,1), local2, trim(type3)//' Y' ) end do @@ -1784,7 +1784,7 @@ subroutine update_domains_performance( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .false. ) + name = type, symmetry = .false. ) else if(folded_north) then !--- Contact line 1, between tile 1 (EAST) and tile 1 (WEST) --- cyclic tile1(1) = 1; tile2(1) = 1 @@ -1797,7 +1797,7 @@ subroutine update_domains_performance( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .false. ) + name = type, symmetry = .false. ) else if( four_tile ) then call define_fourtile_mosaic(type, domain, (/nx,nx,nx,nx/), (/ny,ny,ny,ny/), global_indices, & layout2D, pe_start, pe_end, symmetry = .false. ) @@ -2353,7 +2353,7 @@ subroutine test_mpp_global_sum( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .false. ) + name = type, symmetry = .false. ) else if( cubic_grid ) then call define_cubic_mosaic(type, domain, (/nx,nx,nx,nx,nx,nx/), (/ny,ny,ny,ny,ny,ny/), & global_indices, layout2D, pe_start, pe_end ) @@ -2574,7 +2574,7 @@ subroutine test_group_update( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, symmetry = .false. ) + name = type, symmetry = .false. ) else if( cubic_grid ) then call define_cubic_mosaic(type, domain, (/nx,nx,nx,nx,nx,nx/), (/ny,ny,ny,ny,ny,ny/), & global_indices, layout2D, pe_start, pe_end ) @@ -3073,7 +3073,7 @@ subroutine test_halosize_update( type ) call mpp_define_domains((/1,nx,1,ny/), layout, domain, & xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - symmetry=is_symmetry, domain_name=type ) + symmetry=is_symmetry, name=type ) else if( cubic_grid ) then allocate(layout2D(2,ntiles), global_indices(4,ntiles), pe_start(ntiles), pe_end(ntiles) ) do n = 1, ntiles @@ -3477,7 +3477,7 @@ subroutine test_unstruct_update( type ) ntiles_grid = 1 !--- define the unstructured grid domain call mpp_define_unstruct_domain(UG_domain, SG_domain, npts_tile, ntiles_grid, mpp_npes(), 1, grid_index, & - domain_name="LAND unstruct") + name="LAND unstruct") call mpp_get_UG_compute_domain(UG_domain, istart, iend) !--- figure out lmask according to grid_index @@ -4247,7 +4247,7 @@ subroutine test_nonuniform_mosaic( type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = type, memory_size = msize, symmetry = .true. ) + name = type, memory_size = msize, symmetry = .true. ) end select !--- setup data @@ -4631,15 +4631,15 @@ subroutine test_get_boundary(type) call mpp_define_domains((/1,nx,1,ny/), layout, domain, & xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - symmetry=.true., domain_name='tripolar' ) + symmetry=.true., name='tripolar' ) call mpp_define_domains((/1,nx,1,ny/), layout, domain_nonsym, & xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - symmetry=.false., domain_name='tripolar' ) + symmetry=.false., name='tripolar' ) case("torus") call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, & - yflags=CYCLIC_GLOBAL_DOMAIN, symmetry=.true., domain_name=type) + yflags=CYCLIC_GLOBAL_DOMAIN, symmetry=.true., name=type) end select !--- Test the get_boundary of the data at C-cell center. @@ -5426,7 +5426,7 @@ subroutine test_subset_update( ) ni = 3; nj =3 call mpp_define_domains((/1,ni,1,nj/), layout, domain, xhalo=1& &, yhalo=1, xflags=CYCLIC_GLOBAL_DOMAIN, yflags& - &=CYCLIC_GLOBAL_DOMAIN, domain_name='subset domain') + &=CYCLIC_GLOBAL_DOMAIN, name='subset domain') call mpp_get_compute_domain(domain, is, ie, js, je) allocate(global(0:ni+1,0:nj+1,nz) ) @@ -5497,7 +5497,7 @@ subroutine test_update_edge( type ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=type, symmetry = is_symmetry ) + name=type, symmetry = is_symmetry ) global(1-whalo:0, 1:ny,:) = global(nx-whalo+1:nx, 1:ny,:) global(nx+1:nx+ehalo, 1:ny,:) = global(1:ehalo, 1:ny,:) global(1:nx, 1-shalo:0,:) = global(1:nx, ny-shalo+1:ny,:) @@ -5506,7 +5506,7 @@ subroutine test_update_edge( type ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & - domain_name=type, symmetry = is_symmetry ) + name=type, symmetry = is_symmetry ) call fill_folded_north_halo(global, 0, 0, 0, 0, 1) !--- set the corner to 0 call set_corner_zero(global, 1-whalo, nx+ehalo, 1-shalo, ny+ehalo, 1, nx, 1, ny) @@ -5726,7 +5726,7 @@ subroutine test_update_nonsym_edge( type ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & - domain_name=type, symmetry = is_symmetry ) + name=type, symmetry = is_symmetry ) case default call mpp_error( FATAL, 'test_update_edge: no such test: '//type ) end select @@ -5847,7 +5847,7 @@ subroutine test_cyclic_offset( type ) write(type2, *)type, ' x_cyclic=', x_cyclic_offset call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=type, x_cyclic_offset = x_cyclic_offset) + name=type, x_cyclic_offset = x_cyclic_offset) do j = 1, ny jj = mod(j + x_cyclic_offset + ny, ny) if(jj==0) jj = ny @@ -5860,7 +5860,7 @@ subroutine test_cyclic_offset( type ) write(type2, *)type, ' y_cyclic = ', y_cyclic_offset call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=type, y_cyclic_offset = y_cyclic_offset) + name=type, y_cyclic_offset = y_cyclic_offset) do i = 1, nx ii = mod(i + y_cyclic_offset + nx, nx) if(ii==0) ii = nx @@ -5873,7 +5873,7 @@ subroutine test_cyclic_offset( type ) write(type2, *)type, ' x_cyclic = ', x_cyclic_offset call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, & - yflags=CYCLIC_GLOBAL_DOMAIN, domain_name=type, & + yflags=CYCLIC_GLOBAL_DOMAIN, name=type, & x_cyclic_offset = x_cyclic_offset) do j = 1, ny jj = mod(j + x_cyclic_offset + ny, ny) @@ -5907,7 +5907,7 @@ subroutine test_cyclic_offset( type ) write(type2, *)type, ' y_cyclic = ', y_cyclic_offset call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, & - yflags=CYCLIC_GLOBAL_DOMAIN, domain_name=type, & + yflags=CYCLIC_GLOBAL_DOMAIN, name=type, & y_cyclic_offset = y_cyclic_offset) do i = 1, nx ii = mod(i + y_cyclic_offset + nx, nx) diff --git a/test_fms/mpp/test_mpp_global_field.F90 b/test_fms/mpp/test_mpp_global_field.F90 index 4587069a74..31a6bce996 100644 --- a/test_fms/mpp/test_mpp_global_field.F90 +++ b/test_fms/mpp/test_mpp_global_field.F90 @@ -130,10 +130,10 @@ subroutine test_global_field_r4_2d( type ) select case(type) case( 'Non-symmetry' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Symmetry center', 'Symmetry corner', 'Symmetry east', 'Symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) end select @@ -282,10 +282,10 @@ subroutine test_global_field_r8_2d( type ) select case(type) case( 'Non-symmetry' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Symmetry center', 'Symmetry corner', 'Symmetry east', 'Symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) end select @@ -434,10 +434,10 @@ subroutine test_global_field_i4_2d( type ) select case(type) case( 'Non-symmetry' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Symmetry center', 'Symmetry corner', 'Symmetry east', 'Symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) end select @@ -586,10 +586,10 @@ subroutine test_global_field_i8_2d( type ) select case(type) case( 'Non-symmetry' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Symmetry center', 'Symmetry corner', 'Symmetry east', 'Symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) end select @@ -738,10 +738,10 @@ subroutine test_global_field_r4_3d( type ) select case(type) case( 'Non-symmetry' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Symmetry center', 'Symmetry corner', 'Symmetry east', 'Symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) end select @@ -887,10 +887,10 @@ subroutine test_global_field_r8_3d( type ) select case(type) case( 'Non-symmetry' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Symmetry center', 'Symmetry corner', 'Symmetry east', 'Symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) end select @@ -1036,10 +1036,10 @@ subroutine test_global_field_i4_3d( type ) select case(type) case( 'Non-symmetry' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Symmetry center', 'Symmetry corner', 'Symmetry east', 'Symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) end select @@ -1185,10 +1185,10 @@ subroutine test_global_field_i8_3d( type ) select case(type) case( 'Non-symmetry' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type ) + shalo=shalo, nhalo=nhalo, name=type ) case( 'Symmetry center', 'Symmetry corner', 'Symmetry east', 'Symmetry north' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=type, symmetry = .true. ) + shalo=shalo, nhalo=nhalo, name=type, symmetry = .true. ) case default call mpp_error( FATAL, 'TEST_MPP_DOMAINS: no such test: '//type//' in test_global_field' ) end select diff --git a/test_fms/mpp/test_mpp_global_field_ug.F90 b/test_fms/mpp/test_mpp_global_field_ug.F90 index 9d8622a530..5a1ccda6ef 100644 --- a/test_fms/mpp/test_mpp_global_field_ug.F90 +++ b/test_fms/mpp/test_mpp_global_field_ug.F90 @@ -580,7 +580,7 @@ subroutine setup_domains() ntiles_grid = 1 !--- define the unstructured grid domain call mpp_define_unstruct_domain(UG_domain, SG_domain, npts_tile, ntiles_grid, mpp_npes(), 1, grid_index, & - & domain_name="LAND unstruct") + & name="LAND unstruct") call mpp_get_UG_compute_domain(UG_domain, istart, iend) !--- figure out lmask according to grid_index @@ -686,12 +686,12 @@ subroutine define_cubic_mosaic(type, domain, ni, nj, global_indices, layout, pe_ call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, symmetry = .true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name = trim(type), memory_size = msize ) + shalo=shalo, nhalo=nhalo, name = trim(type), memory_size = msize ) else call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, symmetry = .true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name = trim(type) ) + shalo=shalo, nhalo=nhalo, name = trim(type) ) endif return diff --git a/test_fms/mpp/test_mpp_global_sum_ad.F90 b/test_fms/mpp/test_mpp_global_sum_ad.F90 index dde779763d..c50f9a060e 100644 --- a/test_fms/mpp/test_mpp_global_sum_ad.F90 +++ b/test_fms/mpp/test_mpp_global_sum_ad.F90 @@ -1027,10 +1027,10 @@ subroutine generate_domain(domain, domain_type) select case(trim(domain_type)) case( 'Simple' ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, & - ehalo=ehalo, shalo=shalo, nhalo=nhalo, domain_name=domain_type ) + ehalo=ehalo, shalo=shalo, nhalo=nhalo, name=domain_type ) case( 'Cyclic symmetry center') call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, & - ehalo=ehalo, shalo=shalo, nhalo=nhalo, domain_name=domain_type, symmetry = .true., & + ehalo=ehalo, shalo=shalo, nhalo=nhalo, name=domain_type, symmetry = .true., & xflags=CYCLIC_GLOBAL_DOMAIN, yflags=CYCLIC_GLOBAL_DOMAIN ) case default call mpp_error( FATAL, 'test_mpp_global_sum_ad: no such test: '//trim(domain_type)) diff --git a/test_fms/mpp/test_mpp_nesting.F90 b/test_fms/mpp/test_mpp_nesting.F90 index bd9f5acb72..8808f0e9c8 100644 --- a/test_fms/mpp/test_mpp_nesting.F90 +++ b/test_fms/mpp/test_mpp_nesting.F90 @@ -236,7 +236,7 @@ subroutine test_nest_halo_update_r4( domain ) x(isc:iec,jsc:jec,:) = global(isc:iec,jsc:jec,:) type = 'nest grid scalar' - call mpp_update_domains( x, domain, str_name=trim(type) ) + call mpp_update_domains( x, domain, name=trim(type) ) call compare_checksums( x(isd:ied,jsd:jed,:), global(isd:ied,jsd:jed,:), trim(type) ) @@ -267,7 +267,7 @@ subroutine test_nest_halo_update_r4( domain ) y (isc:iec+shift,jsc:jec+shift,:) = global2(isc:iec+shift,jsc:jec+shift,:) type = 'nest grid BGRID_NE' - call mpp_update_domains( x, y, domain, gridtype=BGRID_NE, str_name=trim(type)) + call mpp_update_domains( x, y, domain, gridtype=BGRID_NE, name=trim(type)) call compare_checksums( x (isd:ied+shift,jsd:jed+shift,:), global1(isd:ied+shift,jsd:jed+shift,:), & & trim(type)//' X' ) @@ -301,7 +301,7 @@ subroutine test_nest_halo_update_r4( domain ) y (isc:iec,jsc:jec+shift,:) = global2(isc:iec,jsc:jec+shift,:) type = "nest grid CGRID_NE" - call mpp_update_domains( x, y, domain, gridtype=CGRID_NE, str_name=trim(type)) + call mpp_update_domains( x, y, domain, gridtype=CGRID_NE, name=trim(type)) call compare_checksums( x(isd:ied+shift,jsd:jed,:), global1(isd:ied+shift,jsd:jed,:), trim(type)//' X' ) call compare_checksums( y(isd:ied,jsd:jed+shift,:), global2(isd:ied,jsd:jed+shift,:), trim(type)//' Y' ) @@ -340,7 +340,7 @@ subroutine test_nest_halo_update_r8( domain ) x(isc:iec,jsc:jec,:) = global(isc:iec,jsc:jec,:) type = 'nest grid scalar' - call mpp_update_domains( x, domain, str_name=trim(type) ) + call mpp_update_domains( x, domain, name=trim(type) ) call compare_checksums( x(isd:ied,jsd:jed,:), global(isd:ied,jsd:jed,:), trim(type) ) @@ -371,7 +371,7 @@ subroutine test_nest_halo_update_r8( domain ) y (isc:iec+shift,jsc:jec+shift,:) = global2(isc:iec+shift,jsc:jec+shift,:) type = 'nest grid BGRID_NE' - call mpp_update_domains( x, y, domain, gridtype=BGRID_NE, str_name=trim(type)) + call mpp_update_domains( x, y, domain, gridtype=BGRID_NE, name=trim(type)) call compare_checksums( x (isd:ied+shift,jsd:jed+shift,:), global1(isd:ied+shift,jsd:jed+shift,:), & & trim(type)//' X' ) @@ -405,7 +405,7 @@ subroutine test_nest_halo_update_r8( domain ) y (isc:iec,jsc:jec+shift,:) = global2(isc:iec,jsc:jec+shift,:) type = "nest grid CGRID_NE" - call mpp_update_domains( x, y, domain, gridtype=CGRID_NE, str_name=trim(type)) + call mpp_update_domains( x, y, domain, gridtype=CGRID_NE, name=trim(type)) call compare_checksums( x(isd:ied+shift,jsd:jed,:), global1(isd:ied+shift,jsd:jed,:), trim(type)//' X' ) call compare_checksums( y(isd:ied,jsd:jed+shift,:), global2(isd:ied,jsd:jed+shift,:), trim(type)//' Y' ) @@ -898,7 +898,7 @@ subroutine test_update_nest_domain_r8( type ) else call mpp_define_domains(global_indices(:,ntiles_nest_top), layout2D(:,ntiles_nest_top), domain, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - symmetry=.true., domain_name=trim(type)//' top level grid', tile_id=1 ) + symmetry=.true., name=trim(type)//' top level grid', tile_id=1 ) endif call mpp_get_compute_domain(domain, isc_coarse, iec_coarse, jsc_coarse, jec_coarse) call mpp_get_data_domain(domain, isd_coarse, ied_coarse, jsd_coarse, jed_coarse) @@ -925,7 +925,7 @@ subroutine test_update_nest_domain_r8( type ) endif call mpp_define_domains((/1,nx_fine,1,ny_fine/), layout, domain, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - symmetry=.true., domain_name=trim(type)//' fine grid', tile_id = tile_fine(n) ) + symmetry=.true., name=trim(type)//' fine grid', tile_id = tile_fine(n) ) call mpp_get_compute_domain(domain, isc_fine, iec_fine, jsc_fine, jec_fine) call mpp_get_data_domain(domain, isd_fine, ied_fine, jsd_fine, jed_fine) !--- test halo update for nested region. @@ -945,7 +945,7 @@ subroutine test_update_nest_domain_r8( type ) call mpp_define_nest_domains(nest_domain, domain, num_nest, nest_level(1:num_nest), tile_fine(1:num_nest), & tile_coarse(1:num_nest), istart_coarse(1:num_nest), icount_coarse(1:num_nest), jstart_coarse(1:num_nest),& jcount_coarse(1:num_nest), npes_nest_tile(1:ntiles_nest_all), & - x_refine(1:num_nest), y_refine(1:num_nest), extra_halo=extra_halo, domain_name="nest_domain") + x_refine(1:num_nest), y_refine(1:num_nest), extra_halo=extra_halo, name="nest_domain") !--- loop over nest level do l = 1, num_nest_level @@ -2933,7 +2933,7 @@ subroutine test_update_nest_domain_r4( type ) else call mpp_define_domains(global_indices(:,ntiles_nest_top), layout2D(:,ntiles_nest_top), domain, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - symmetry=.true., domain_name=trim(type)//' top level grid', tile_id=1 ) + symmetry=.true., name=trim(type)//' top level grid', tile_id=1 ) endif call mpp_get_compute_domain(domain, isc_coarse, iec_coarse, jsc_coarse, jec_coarse) call mpp_get_data_domain(domain, isd_coarse, ied_coarse, jsd_coarse, jed_coarse) @@ -2960,7 +2960,7 @@ subroutine test_update_nest_domain_r4( type ) endif call mpp_define_domains((/1,nx_fine,1,ny_fine/), layout, domain, & whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - symmetry=.true., domain_name=trim(type)//' fine grid', tile_id = tile_fine(n) ) + symmetry=.true., name=trim(type)//' fine grid', tile_id = tile_fine(n) ) call mpp_get_compute_domain(domain, isc_fine, iec_fine, jsc_fine, jec_fine) call mpp_get_data_domain(domain, isd_fine, ied_fine, jsd_fine, jed_fine) !--- test halo update for nested region. @@ -2980,7 +2980,7 @@ subroutine test_update_nest_domain_r4( type ) call mpp_define_nest_domains(nest_domain, domain, num_nest, nest_level(1:num_nest), tile_fine(1:num_nest), & tile_coarse(1:num_nest), istart_coarse(1:num_nest), icount_coarse(1:num_nest), jstart_coarse(1:num_nest),& jcount_coarse(1:num_nest), npes_nest_tile(1:ntiles_nest_all), & - x_refine(1:num_nest), y_refine(1:num_nest), extra_halo=extra_halo, domain_name="nest_domain") + x_refine(1:num_nest), y_refine(1:num_nest), extra_halo=extra_halo, name="nest_domain") !--- loop over nest level do l = 1, num_nest_level diff --git a/test_fms/mpp/test_mpp_update_domains_ad.F90 b/test_fms/mpp/test_mpp_update_domains_ad.F90 index b8435b2e8e..aeaf253528 100644 --- a/test_fms/mpp/test_mpp_update_domains_ad.F90 +++ b/test_fms/mpp/test_mpp_update_domains_ad.F90 @@ -83,7 +83,7 @@ subroutine test_halo_update_ad_r8( test_type ) case( 'Simple', 'Simple symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=test_type, symmetry = is_symmetry ) + shalo=shalo, nhalo=nhalo, name=test_type, symmetry = is_symmetry ) case default call mpp_error( FATAL, 'test_mpp_update_domains_ad_r8: '//test_type//' is not a valid test.') end select @@ -243,7 +243,7 @@ subroutine test_halo_update_ad_r4( test_type ) case( 'Simple', 'Simple symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=test_type, symmetry = is_symmetry ) + shalo=shalo, nhalo=nhalo, name=test_type, symmetry = is_symmetry ) case default call mpp_error( FATAL, 'test_mpp_update_domains_ad_r4: '//test_type//' is not a valid test.') end select diff --git a/test_fms/mpp/test_mpp_update_domains_int.F90 b/test_fms/mpp/test_mpp_update_domains_int.F90 index 64f6d667e4..11e3e80aa6 100644 --- a/test_fms/mpp/test_mpp_update_domains_int.F90 +++ b/test_fms/mpp/test_mpp_update_domains_int.F90 @@ -107,12 +107,12 @@ subroutine test_halo_update_i8( domain_type ) case( 'Simple', 'Simple symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=trim(domain_type), symmetry = is_symmetry ) + shalo=shalo, nhalo=nhalo, name=trim(domain_type), symmetry = is_symmetry ) case( 'Cyclic', 'Cyclic symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=trim(domain_type), symmetry = is_symmetry ) + name=trim(domain_type), symmetry = is_symmetry ) globali8(1-whalo:0, 1:ny,:) = globali8(nx-whalo+1:nx, 1:ny,:) globali8(nx+1:nx+ehalo, 1:ny,:) = globali8(1:ehalo, 1:ny,:) globali8(1-whalo:nx+ehalo, 1-shalo:0,:) = globali8(1-whalo:nx+ehalo, ny-shalo+1:ny,:) @@ -192,12 +192,12 @@ subroutine test_halo_update_i4( domain_type ) case( 'Simple', 'Simple symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=trim(domain_type), symmetry = is_symmetry ) + shalo=shalo, nhalo=nhalo, name=trim(domain_type), symmetry = is_symmetry ) case( 'Cyclic', 'Cyclic symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=trim(domain_type), symmetry = is_symmetry ) + name=trim(domain_type), symmetry = is_symmetry ) globali4(1-whalo:0, 1:ny,:) = globali4(nx-whalo+1:nx, 1:ny,:) globali4(nx+1:nx+ehalo, 1:ny,:) = globali4(1:ehalo, 1:ny,:) globali4(1-whalo:nx+ehalo, 1-shalo:0,:) = globali4(1-whalo:nx+ehalo, ny-shalo+1:ny,:) @@ -262,7 +262,7 @@ subroutine test_subset_update_i8( ) ni = 3; nj =3 call mpp_define_domains((/1,ni,1,nj/), layout, domain, xhalo=1 & &, yhalo=1, xflags=CYCLIC_GLOBAL_DOMAIN, yflags& - &=CYCLIC_GLOBAL_DOMAIN, domain_name='subset domain') + &=CYCLIC_GLOBAL_DOMAIN, name='subset domain') call mpp_get_compute_domain(domain, is, ie, js, je) print*, "pe=", mpp_pe(), is, ie, js, je @@ -325,7 +325,7 @@ subroutine test_subset_update_i4( ) ni = 3; nj =3 call mpp_define_domains((/1,ni,1,nj/), layout, domain, xhalo=1 & &, yhalo=1, xflags=CYCLIC_GLOBAL_DOMAIN, yflags& - &=CYCLIC_GLOBAL_DOMAIN, domain_name='subset domain') + &=CYCLIC_GLOBAL_DOMAIN, name='subset domain') call mpp_get_compute_domain(domain, is, ie, js, je) print*, "pe=", mpp_pe(), is, ie, js, je diff --git a/test_fms/mpp/test_mpp_update_domains_real.F90 b/test_fms/mpp/test_mpp_update_domains_real.F90 index e7e1ae0623..d1b28d284c 100644 --- a/test_fms/mpp/test_mpp_update_domains_real.F90 +++ b/test_fms/mpp/test_mpp_update_domains_real.F90 @@ -119,12 +119,12 @@ subroutine test_halo_update_r8( domain_type ) case( 'Simple', 'Simple symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=trim(domain_type), symmetry = is_symmetry ) + shalo=shalo, nhalo=nhalo, name=trim(domain_type), symmetry = is_symmetry ) case( 'Cyclic', 'Cyclic symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=trim(domain_type), symmetry = is_symmetry ) + name=trim(domain_type), symmetry = is_symmetry ) globalr8(1-whalo:0, 1:ny,:) = globalr8(nx-whalo+1:nx, 1:ny,:) globalr8(nx+1:nx+ehalo, 1:ny,:) = globalr8(1:ehalo, 1:ny,:) globalr8(1-whalo:nx+ehalo, 1-shalo:0,:) = globalr8(1-whalo:nx+ehalo, ny-shalo+1:ny,:) @@ -133,30 +133,30 @@ subroutine test_halo_update_r8( domain_type ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & - domain_name=domain_type, symmetry = is_symmetry ) + name=domain_type, symmetry = is_symmetry ) call fill_folded_north_halo(globalr8, 0, 0, 0, 0, 1) case( 'Folded-south symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_SOUTH_EDGE, & - domain_name=domain_type, symmetry = is_symmetry ) + name=domain_type, symmetry = is_symmetry ) call fill_folded_south_halo(globalr8, 0, 0, 0, 0, 1) case( 'Folded-west symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=FOLD_WEST_EDGE, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=domain_type, symmetry = is_symmetry ) + name=domain_type, symmetry = is_symmetry ) call fill_folded_west_halo(globalr8, 0, 0, 0, 0, 1) case( 'Folded-east symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=FOLD_EAST_EDGE, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=domain_type, symmetry = is_symmetry ) + name=domain_type, symmetry = is_symmetry ) call fill_folded_east_halo(globalr8, 0, 0, 0, 0, 1) case( 'Folded xy_halo' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, xhalo=xhalo, yhalo=yhalo, & - xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, domain_name=domain_type, symmetry = is_symmetry ) + xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, name=domain_type, symmetry = is_symmetry ) globalr8(1-xhalo:0, 1:ny,:) = globalr8(nx-xhalo+1:nx, 1:ny,:) globalr8(nx+1:nx+xhalo, 1:ny,:) = globalr8(1:xhalo, 1:ny,:) globalr8(1-xhalo:nx+xhalo,ny+1:ny+yhalo,:) = globalr8(nx+xhalo:1-xhalo:-1, ny:ny-yhalo+1:-1,:) @@ -167,7 +167,7 @@ subroutine test_halo_update_r8( domain_type ) maskmap(:,:) = .TRUE.; maskmap(layout(1),layout(2)) = .FALSE. call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & - maskmap=maskmap, domain_name=domain_type, symmetry = is_symmetry ) + maskmap=maskmap, name=domain_type, symmetry = is_symmetry ) deallocate(maskmap) !we need to zero out the globalr8 data on the missing domain. !this logic assumes top-right, in an even division @@ -516,12 +516,12 @@ subroutine test_halo_update_r4( domain_type ) case( 'Simple', 'Simple symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name=trim(domain_type), symmetry = is_symmetry ) + shalo=shalo, nhalo=nhalo, name=trim(domain_type), symmetry = is_symmetry ) case( 'Cyclic', 'Cyclic symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=trim(domain_type), symmetry = is_symmetry ) + name=trim(domain_type), symmetry = is_symmetry ) globalr4(1-whalo:0, 1:ny,:) = globalr4(nx-whalo+1:nx, 1:ny,:) globalr4(nx+1:nx+ehalo, 1:ny,:) = globalr4(1:ehalo, 1:ny,:) globalr4(1-whalo:nx+ehalo, 1-shalo:0,:) = globalr4(1-whalo:nx+ehalo, ny-shalo+1:ny,:) @@ -530,30 +530,30 @@ subroutine test_halo_update_r4( domain_type ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & - domain_name=domain_type, symmetry = is_symmetry ) + name=domain_type, symmetry = is_symmetry ) call fill_folded_north_halo(globalr4, 0, 0, 0, 0, 1) case( 'Folded-south symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_SOUTH_EDGE, & - domain_name=domain_type, symmetry = is_symmetry ) + name=domain_type, symmetry = is_symmetry ) call fill_folded_south_halo(globalr4, 0, 0, 0, 0, 1) case( 'Folded-west symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=FOLD_WEST_EDGE, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=domain_type, symmetry = is_symmetry ) + name=domain_type, symmetry = is_symmetry ) call fill_folded_west_halo(globalr4, 0, 0, 0, 0, 1) case( 'Folded-east symmetry' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=FOLD_EAST_EDGE, yflags=CYCLIC_GLOBAL_DOMAIN, & - domain_name=domain_type, symmetry = is_symmetry ) + name=domain_type, symmetry = is_symmetry ) call fill_folded_east_halo(globalr4, 0, 0, 0, 0, 1) case( 'Folded xy_halo' ) call mpp_define_layout( (/1,nx,1,ny/), npes, layout ) call mpp_define_domains( (/1,nx,1,ny/), layout, domain, xhalo=xhalo, yhalo=yhalo, & - xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, domain_name=domain_type, symmetry = is_symmetry) + xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, name=domain_type, symmetry = is_symmetry) globalr4(1-xhalo:0, 1:ny,:) = globalr4(nx-xhalo+1:nx, 1:ny,:) globalr4(nx+1:nx+xhalo, 1:ny,:) = globalr4(1:xhalo, 1:ny,:) globalr4(1-xhalo:nx+xhalo,ny+1:ny+yhalo,:) = globalr4(nx+xhalo:1-xhalo:-1, ny:ny-yhalo+1:-1,:) @@ -564,7 +564,7 @@ subroutine test_halo_update_r4( domain_type ) maskmap(:,:) = .TRUE.; maskmap(layout(1),layout(2)) = .FALSE. call mpp_define_domains( (/1,nx,1,ny/), layout, domain, whalo=whalo, ehalo=ehalo, & shalo=shalo, nhalo=nhalo, xflags=CYCLIC_GLOBAL_DOMAIN, yflags=FOLD_NORTH_EDGE, & - maskmap=maskmap, domain_name=domain_type, symmetry = is_symmetry ) + maskmap=maskmap, name=domain_type, symmetry = is_symmetry ) deallocate(maskmap) ! we need to zero out the globalr4 data on the missing domain. ! this logic assumes top-right, in an even division @@ -880,7 +880,7 @@ subroutine test_subset_update_r8( ) ni = 3; nj =3 call mpp_define_domains((/1,ni,1,nj/), layout, domain, xhalo=1 & &, yhalo=1, xflags=CYCLIC_GLOBAL_DOMAIN, yflags& - &=CYCLIC_GLOBAL_DOMAIN, domain_name='subset domain') + &=CYCLIC_GLOBAL_DOMAIN, name='subset domain') call mpp_get_compute_domain(domain, is, ie, js, je) print*, "pe=", mpp_pe(), is, ie, js, je @@ -942,7 +942,7 @@ subroutine test_subset_update_r4( ) ni = 3; nj =3 call mpp_define_domains((/1,ni,1,nj/), layout, domain, xhalo=1 & &, yhalo=1, xflags=CYCLIC_GLOBAL_DOMAIN, yflags& - &=CYCLIC_GLOBAL_DOMAIN, domain_name='subset domain') + &=CYCLIC_GLOBAL_DOMAIN, name='subset domain') call mpp_get_compute_domain(domain, is, ie, js, je) print*, "pe=", mpp_pe(), is, ie, js, je diff --git a/test_fms/mpp/test_redistribute_int.F90 b/test_fms/mpp/test_redistribute_int.F90 index d4c9be57cb..144affe1c8 100644 --- a/test_fms/mpp/test_redistribute_int.F90 +++ b/test_fms/mpp/test_redistribute_int.F90 @@ -738,7 +738,7 @@ subroutine define_cubic_mosaic(type, domain, ni, nj, global_indices, layout, pe_ call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, symmetry = .true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name = trim(type), memory_size = msize ) + shalo=shalo, nhalo=nhalo, name = trim(type), memory_size = msize ) end subroutine define_cubic_mosaic diff --git a/test_fms/mpp/test_super_grid.F90 b/test_fms/mpp/test_super_grid.F90 index ce488d8344..a8f6ccbb23 100644 --- a/test_fms/mpp/test_super_grid.F90 +++ b/test_fms/mpp/test_super_grid.F90 @@ -42,7 +42,7 @@ program test_super_grid nlon = 360 nlat = 90 -call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, xhalo=2, yhalo=2, domain_name='test_supergrid') +call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, xhalo=2, yhalo=2, name='test_supergrid') call mpp_copy_domain(Domain, Domain2) call compare_domains(Domain, Domain2, supergrid=.false.) diff --git a/test_fms/mpp/test_update_domains_performance.F90 b/test_fms/mpp/test_update_domains_performance.F90 index 83f8c28a5c..a0a81443e2 100644 --- a/test_fms/mpp/test_update_domains_performance.F90 +++ b/test_fms/mpp/test_update_domains_performance.F90 @@ -229,7 +229,7 @@ subroutine update_domains_performance_r8( test_type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = test_type, symmetry = .false. ) + name = test_type, symmetry = .false. ) else if(folded_north) then !--- Contact line 1, between tile 1 (EAST) and tile 1 (WEST) --- cyclic tile1(1) = 1; tile2(1) = 1 @@ -242,7 +242,7 @@ subroutine update_domains_performance_r8( test_type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = test_type, symmetry = .false. ) + name = test_type, symmetry = .false. ) else if( cubic_grid ) then call define_cubic_mosaic(test_type, domain, (/nx,nx,nx,nx,nx,nx/), (/ny,ny,ny,ny,ny,ny/), & global_indices, layout2D, pe_start, pe_end ) @@ -835,7 +835,7 @@ subroutine update_domains_performance_r4( test_type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = test_type, symmetry = .false. ) + name = test_type, symmetry = .false. ) else if(folded_north) then !--- Contact line 1, between tile 1 (EAST) and tile 1 (WEST) --- cyclic tile1(1) = 1; tile2(1) = 1 @@ -848,7 +848,7 @@ subroutine update_domains_performance_r4( test_type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = test_type, symmetry = .false. ) + name = test_type, symmetry = .false. ) else if( cubic_grid ) then call define_cubic_mosaic(test_type, domain, (/nx,nx,nx,nx,nx,nx/), (/ny,ny,ny,ny,ny,ny/), & global_indices, layout2D, pe_start, pe_end ) @@ -1435,7 +1435,7 @@ subroutine update_domains_performance_i8( test_type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = test_type, symmetry = .false. ) + name = test_type, symmetry = .false. ) else if(folded_north) then !--- Contact line 1, between tile 1 (EAST) and tile 1 (WEST) --- cyclic tile1(1) = 1; tile2(1) = 1 @@ -1448,7 +1448,7 @@ subroutine update_domains_performance_i8( test_type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = test_type, symmetry = .false. ) + name = test_type, symmetry = .false. ) else if( cubic_grid ) then call define_cubic_mosaic(test_type, domain, (/nx,nx,nx,nx,nx,nx/), (/ny,ny,ny,ny,ny,ny/), & global_indices, layout2D, pe_start, pe_end ) @@ -1696,7 +1696,7 @@ subroutine update_domains_performance_i4( test_type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = test_type, symmetry = .false. ) + name = test_type, symmetry = .false. ) else if(folded_north) then !--- Contact line 1, between tile 1 (EAST) and tile 1 (WEST) --- cyclic tile1(1) = 1; tile2(1) = 1 @@ -1709,7 +1709,7 @@ subroutine update_domains_performance_i4( test_type ) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, & - domain_name = test_type, symmetry = .false. ) + name = test_type, symmetry = .false. ) else if( cubic_grid ) then call define_cubic_mosaic(test_type, domain, (/nx,nx,nx,nx,nx,nx/), (/ny,ny,ny,ny,ny,ny/), & global_indices, layout2D, pe_start, pe_end ) @@ -1918,12 +1918,12 @@ subroutine define_cubic_mosaic(type, domain, ni, nj, global_indices, layout, pe_ call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, symmetry = .true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name = trim(type), memory_size = msize ) + shalo=shalo, nhalo=nhalo, name = trim(type), memory_size = msize ) else call mpp_define_mosaic(global_indices, layout, domain, ntiles, num_contact, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, & pe_start, pe_end, symmetry = .true., whalo=whalo, ehalo=ehalo, & - shalo=shalo, nhalo=nhalo, domain_name = trim(type) ) + shalo=shalo, nhalo=nhalo, name = trim(type) ) endif return diff --git a/test_fms/mpp_io/test_io_mosaic_R4_R8.F90 b/test_fms/mpp_io/test_io_mosaic_R4_R8.F90 index 232c371e73..028e718e56 100644 --- a/test_fms/mpp_io/test_io_mosaic_R4_R8.F90 +++ b/test_fms/mpp_io/test_io_mosaic_R4_R8.F90 @@ -180,7 +180,7 @@ subroutine test_netcdf_io_mosaic_R4(type, layout, ntiles_x, ntiles_y, io_layout) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, ncontacts, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, pe_start, pe_end, & - domain_name = type) + name = type) call mpp_get_compute_domain( domain, isc, iec, jsc, jec ) call mpp_get_domain_components(domain, xdom, ydom) allocate( data (isc:iec,jsc:jec,nz) ) @@ -322,7 +322,7 @@ subroutine test_netcdf_io_mosaic_R8(type, layout, ntiles_x, ntiles_y, io_layout) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, ncontacts, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, pe_start, pe_end, & - domain_name = type) + name = type) call mpp_get_compute_domain( domain, isc, iec, jsc, jec ) call mpp_get_domain_components(domain, xdom, ydom) allocate( data (isc:iec,jsc:jec,nz) ) diff --git a/test_fms/mpp_io/test_mpp_io.F90 b/test_fms/mpp_io/test_mpp_io.F90 index 962b1cc7fc..8c7c095ea0 100644 --- a/test_fms/mpp_io/test_mpp_io.F90 +++ b/test_fms/mpp_io/test_mpp_io.F90 @@ -468,7 +468,7 @@ subroutine test_netcdf_io_mosaic(type, layout, ntiles_x, ntiles_y, io_layout) call mpp_define_mosaic(global_indices, layout2D, domain, ntiles, ncontacts, tile1, tile2, & istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, pe_start, pe_end, & - domain_name = type) + name = type) call mpp_get_compute_domain( domain, isc, iec, jsc, jec ) call mpp_get_domain_components(domain, xdom, ydom) allocate( data (isc:iec,jsc:jec,nz) )