subroutine dyn_mpas_exchange_halo(self, field_name)
! Module(s) from MPAS.
use mpas_derived_types, only: field1dinteger, field2dinteger, field3dinteger, &
field1dreal, field2dreal, field3dreal, field4dreal, field5dreal, &
mpas_pool_field_info_type, mpas_pool_integer, mpas_pool_real
use mpas_dmpar, only: mpas_dmpar_exch_halo_field
use mpas_pool_routines, only: mpas_pool_get_field, mpas_pool_get_field_info
class(mpas_dynamical_core_type), intent(in) :: self
character(*), intent(in) :: field_name
character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_exchange_halo'
type(field1dinteger), pointer :: field_1d_integer
type(field2dinteger), pointer :: field_2d_integer
type(field3dinteger), pointer :: field_3d_integer
type(field1dreal), pointer :: field_1d_real
type(field2dreal), pointer :: field_2d_real
type(field3dreal), pointer :: field_3d_real
type(field4dreal), pointer :: field_4d_real
type(field5dreal), pointer :: field_5d_real
type(mpas_pool_field_info_type) :: mpas_pool_field_info
call self % debug_print(log_level_debug, subname // ' entered')
nullify(field_1d_integer)
nullify(field_2d_integer)
nullify(field_3d_integer)
nullify(field_1d_real)
nullify(field_2d_real)
nullify(field_3d_real)
nullify(field_4d_real)
nullify(field_5d_real)
call self % debug_print(log_level_info, 'Inquiring field information for "' // trim(adjustl(field_name)) // '"')
call mpas_pool_get_field_info(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), mpas_pool_field_info)
if (mpas_pool_field_info % fieldtype == -1 .or. &
mpas_pool_field_info % ndims == -1 .or. &
mpas_pool_field_info % nhalolayers == -1) then
call self % model_error('Invalid field information for "' // trim(adjustl(field_name)) // '"', subname, __LINE__)
end if
! No halo layers to exchange. This field is not decomposed.
if (mpas_pool_field_info % nhalolayers == 0) then
call self % debug_print(log_level_info, 'Skipping field "' // trim(adjustl(field_name)) // &
'" due to not decomposed')
return
end if
call self % debug_print(log_level_info, 'Exchanging halo layers for "' // trim(adjustl(field_name)) // '"')
select case (mpas_pool_field_info % fieldtype)
case (mpas_pool_integer)
select case (mpas_pool_field_info % ndims)
case (1)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), field_1d_integer, timelevel=1)
if (.not. associated(field_1d_integer)) then
call self % model_error('Failed to find field "' // trim(adjustl(field_name)) // &
'"', subname, __LINE__)
end if
call mpas_dmpar_exch_halo_field(field_1d_integer)
nullify(field_1d_integer)
case (2)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), field_2d_integer, timelevel=1)
if (.not. associated(field_2d_integer)) then
call self % model_error('Failed to find field "' // trim(adjustl(field_name)) // &
'"', subname, __LINE__)
end if
call mpas_dmpar_exch_halo_field(field_2d_integer)
nullify(field_2d_integer)
case (3)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), field_3d_integer, timelevel=1)
if (.not. associated(field_3d_integer)) then
call self % model_error('Failed to find field "' // trim(adjustl(field_name)) // &
'"', subname, __LINE__)
end if
call mpas_dmpar_exch_halo_field(field_3d_integer)
nullify(field_3d_integer)
case default
call self % model_error('Unsupported field rank ' // stringify([mpas_pool_field_info % ndims]), &
subname, __LINE__)
end select
case (mpas_pool_real)
select case (mpas_pool_field_info % ndims)
case (1)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), field_1d_real, timelevel=1)
if (.not. associated(field_1d_real)) then
call self % model_error('Failed to find field "' // trim(adjustl(field_name)) // &
'"', subname, __LINE__)
end if
call mpas_dmpar_exch_halo_field(field_1d_real)
nullify(field_1d_real)
case (2)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), field_2d_real, timelevel=1)
if (.not. associated(field_2d_real)) then
call self % model_error('Failed to find field "' // trim(adjustl(field_name)) // &
'"', subname, __LINE__)
end if
call mpas_dmpar_exch_halo_field(field_2d_real)
nullify(field_2d_real)
case (3)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), field_3d_real, timelevel=1)
if (.not. associated(field_3d_real)) then
call self % model_error('Failed to find field "' // trim(adjustl(field_name)) // &
'"', subname, __LINE__)
end if
call mpas_dmpar_exch_halo_field(field_3d_real)
nullify(field_3d_real)
case (4)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), field_4d_real, timelevel=1)
if (.not. associated(field_4d_real)) then
call self % model_error('Failed to find field "' // trim(adjustl(field_name)) // &
'"', subname, __LINE__)
end if
call mpas_dmpar_exch_halo_field(field_4d_real)
nullify(field_4d_real)
case (5)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(field_name)), field_5d_real, timelevel=1)
if (.not. associated(field_5d_real)) then
call self % model_error('Failed to find field "' // trim(adjustl(field_name)) // &
'"', subname, __LINE__)
end if
call mpas_dmpar_exch_halo_field(field_5d_real)
nullify(field_5d_real)
case default
call self % model_error('Unsupported field rank ' // stringify([mpas_pool_field_info % ndims]), &
subname, __LINE__)
end select
case default
call self % model_error('Unsupported field type (Must be one of: integer, real)', subname, __LINE__)
end select
call self % debug_print(log_level_debug, subname // ' completed')
end subroutine dyn_mpas_exchange_halo