subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compatible, pio_file, var_info)
! Module(s) from external libraries.
use pio, only: file_desc_t, pio_file_is_open, &
pio_char, pio_int, pio_real, pio_double, &
pio_inq_varid, pio_inq_varndims, pio_inq_vartype, pio_noerr
! Module(s) from MPAS.
use mpas_derived_types, only: field0dchar, field1dchar, &
field0dinteger, field1dinteger, field2dinteger, field3dinteger, &
field0dreal, field1dreal, field2dreal, field3dreal, field4dreal, field5dreal
use mpas_kind_types, only: r4kind, r8kind
use mpas_pool_routines, only: mpas_pool_get_field
class(mpas_dynamical_core_type), intent(in) :: self
logical, allocatable, intent(out) :: var_is_present(:)
logical, allocatable, intent(out) :: var_is_tkr_compatible(:)
type(file_desc_t), pointer, intent(in) :: pio_file
type(var_info_type), intent(in) :: var_info
character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_check_variable_status'
character(strkind), allocatable :: var_name_list(:)
integer :: i, ierr, varid, varndims, vartype
type(field0dchar), pointer :: field_0d_char
type(field1dchar), pointer :: field_1d_char
type(field0dinteger), pointer :: field_0d_integer
type(field1dinteger), pointer :: field_1d_integer
type(field2dinteger), pointer :: field_2d_integer
type(field3dinteger), pointer :: field_3d_integer
type(field0dreal), pointer :: field_0d_real
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
call self % debug_print(log_level_debug, subname // ' entered')
nullify(field_0d_char)
nullify(field_1d_char)
nullify(field_0d_integer)
nullify(field_1d_integer)
nullify(field_2d_integer)
nullify(field_3d_integer)
nullify(field_0d_real)
nullify(field_1d_real)
nullify(field_2d_real)
nullify(field_3d_real)
nullify(field_4d_real)
nullify(field_5d_real)
! Extract a list of variable names to check on the file.
! For an ordinary variable, this list just contains its name.
! For a variable array, this list contains the names of its constituent parts.
select case (trim(adjustl(var_info % type)))
case ('character')
select case (var_info % rank)
case (0)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_0d_char, timelevel=1)
if (.not. associated(field_0d_char)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_0d_char % isvararray .and. associated(field_0d_char % constituentnames)) then
allocate(var_name_list(size(field_0d_char % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_0d_char % constituentnames(:)
end if
nullify(field_0d_char)
case (1)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_1d_char, timelevel=1)
if (.not. associated(field_1d_char)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_1d_char % isvararray .and. associated(field_1d_char % constituentnames)) then
allocate(var_name_list(size(field_1d_char % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_1d_char % constituentnames(:)
end if
nullify(field_1d_char)
case default
call self % model_error('Unsupported variable rank ' // stringify([var_info % rank]) // &
' for "' // trim(adjustl(var_info % name)) // '"', subname, __LINE__)
end select
case ('integer')
select case (var_info % rank)
case (0)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_0d_integer, timelevel=1)
if (.not. associated(field_0d_integer)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_0d_integer % isvararray .and. associated(field_0d_integer % constituentnames)) then
allocate(var_name_list(size(field_0d_integer % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_0d_integer % constituentnames(:)
end if
nullify(field_0d_integer)
case (1)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_1d_integer, timelevel=1)
if (.not. associated(field_1d_integer)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_1d_integer % isvararray .and. associated(field_1d_integer % constituentnames)) then
allocate(var_name_list(size(field_1d_integer % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_1d_integer % constituentnames(:)
end if
nullify(field_1d_integer)
case (2)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_2d_integer, timelevel=1)
if (.not. associated(field_2d_integer)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_2d_integer % isvararray .and. associated(field_2d_integer % constituentnames)) then
allocate(var_name_list(size(field_2d_integer % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_2d_integer % constituentnames(:)
end if
nullify(field_2d_integer)
case (3)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_3d_integer, timelevel=1)
if (.not. associated(field_3d_integer)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_3d_integer % isvararray .and. associated(field_3d_integer % constituentnames)) then
allocate(var_name_list(size(field_3d_integer % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_3d_integer % constituentnames(:)
end if
nullify(field_3d_integer)
case default
call self % model_error('Unsupported variable rank ' // stringify([var_info % rank]) // &
' for "' // trim(adjustl(var_info % name)) // '"', subname, __LINE__)
end select
case ('real')
select case (var_info % rank)
case (0)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_0d_real, timelevel=1)
if (.not. associated(field_0d_real)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_0d_real % isvararray .and. associated(field_0d_real % constituentnames)) then
allocate(var_name_list(size(field_0d_real % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_0d_real % constituentnames(:)
end if
nullify(field_0d_real)
case (1)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_1d_real, timelevel=1)
if (.not. associated(field_1d_real)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_1d_real % isvararray .and. associated(field_1d_real % constituentnames)) then
allocate(var_name_list(size(field_1d_real % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_1d_real % constituentnames(:)
end if
nullify(field_1d_real)
case (2)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_2d_real, timelevel=1)
if (.not. associated(field_2d_real)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_2d_real % isvararray .and. associated(field_2d_real % constituentnames)) then
allocate(var_name_list(size(field_2d_real % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_2d_real % constituentnames(:)
end if
nullify(field_2d_real)
case (3)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_3d_real, timelevel=1)
if (.not. associated(field_3d_real)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_3d_real % isvararray .and. associated(field_3d_real % constituentnames)) then
allocate(var_name_list(size(field_3d_real % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_3d_real % constituentnames(:)
end if
nullify(field_3d_real)
case (4)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_4d_real, timelevel=1)
if (.not. associated(field_4d_real)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_4d_real % isvararray .and. associated(field_4d_real % constituentnames)) then
allocate(var_name_list(size(field_4d_real % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_4d_real % constituentnames(:)
end if
nullify(field_4d_real)
case (5)
call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, &
trim(adjustl(var_info % name)), field_5d_real, timelevel=1)
if (.not. associated(field_5d_real)) then
call self % model_error('Failed to find variable "' // trim(adjustl(var_info % name)) // &
'"', subname, __LINE__)
end if
if (field_5d_real % isvararray .and. associated(field_5d_real % constituentnames)) then
allocate(var_name_list(size(field_5d_real % constituentnames)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(:) = field_5d_real % constituentnames(:)
end if
nullify(field_5d_real)
case default
call self % model_error('Unsupported variable rank ' // stringify([var_info % rank]) // &
' for "' // trim(adjustl(var_info % name)) // '"', subname, __LINE__)
end select
case default
call self % model_error('Unsupported variable type "' // trim(adjustl(var_info % type)) // &
'" for "' // trim(adjustl(var_info % name)) // '"', subname, __LINE__)
end select
if (.not. allocated(var_name_list)) then
allocate(var_name_list(1), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_name_list', subname, __LINE__)
end if
var_name_list(1) = var_info % name
end if
allocate(var_is_present(size(var_name_list)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_is_present', subname, __LINE__)
end if
var_is_present(:) = .false.
allocate(var_is_tkr_compatible(size(var_name_list)), stat=ierr)
if (ierr /= 0) then
call self % model_error('Failed to allocate var_is_tkr_compatible', subname, __LINE__)
end if
var_is_tkr_compatible(:) = .false.
if (.not. associated(pio_file)) then
return
end if
if (.not. pio_file_is_open(pio_file)) then
return
end if
call self % debug_print(log_level_verbose, 'Checking variable "' // trim(adjustl(var_info % name)) // &
'" for presence and TKR compatibility')
do i = 1, size(var_name_list)
! Check if the variable is present on the file.
ierr = pio_inq_varid(pio_file, trim(adjustl(var_name_list(i))), varid)
if (ierr /= pio_noerr) then
cycle
end if
var_is_present(i) = .true.
! Check if the variable is "TK"R compatible between MPAS and the file.
ierr = pio_inq_vartype(pio_file, varid, vartype)
if (ierr /= pio_noerr) then
cycle
end if
select case (trim(adjustl(var_info % type)))
case ('character')
if (vartype /= pio_char) then
cycle
end if
case ('integer')
if (vartype /= pio_int) then
cycle
end if
case ('real')
! When MPAS dynamical core is compiled at single precision, pairing it with double precision input data
! is not allowed to prevent loss of precision.
if (rkind == r4kind .and. vartype /= pio_real) then
cycle
end if
! When MPAS dynamical core is compiled at double precision, pairing it with single and double precision
! input data is allowed.
if (rkind == r8kind .and. vartype /= pio_real .and. vartype /= pio_double) then
cycle
end if
case default
cycle
end select
! Check if the variable is TK"R" compatible between MPAS and the file.
ierr = pio_inq_varndims(pio_file, varid, varndims)
if (ierr /= pio_noerr) then
cycle
end if
if (varndims /= var_info % rank) then
cycle
end if
var_is_tkr_compatible(i) = .true.
end do
call self % debug_print(log_level_debug, 'var_name_list = ' // stringify(var_name_list))
call self % debug_print(log_level_debug, 'var_is_present = ' // stringify(var_is_present))
call self % debug_print(log_level_debug, 'var_is_tkr_compatible = ' // stringify(var_is_tkr_compatible))
call self % debug_print(log_level_debug, subname // ' completed')
end subroutine dyn_mpas_check_variable_status