subroutine transfer_metadata(this)!vars)
class (RegridSupport), intent(inout) :: this
integer :: status
call add_grid_dimensions()
call add_grid_variables()
call add_global_attributes()
call add_variables()
contains
subroutine add_grid_dimensions()
integer :: status
type (StringIntegerMap), pointer :: dims
dims => this%cfio_cubed_sphere%get_dimensions()
associate ( ll => this%cfio_lat_lon )
call ll%add_dimension('lon', this%IM, rc=status)
call ll%add_dimension('lat', this%JM, rc=status)
if (associated(dims%at('lev'))) then
call ll%add_dimension('lev', this%LM, rc=status)
end if
call ll%add_dimension('time', this%nt, rc=status)
end associate
end subroutine add_grid_dimensions
subroutine add_grid_variables()
type (Variable), pointer :: v
type (Variable) :: tmp
integer :: status
associate ( ll => this%cfio_lat_lon, cs => this%cfio_cubed_sphere )
tmp = Variable(type=pFIO_REAL32, dimensions='lat')
!call tmp%add_attribute('long_name', Attribute('latitude'))
call tmp%add_attribute('long_name', 'latitude')
!call tmp%add_attribute('units', Attribute('degrees_north'))
call tmp%add_attribute('units', 'degrees_north')
call ll%add_variable('lat', tmp, rc=status)
tmp = Variable(type=pFIO_REAL32, dimensions='lon')
!call tmp%add_attribute('long_name', Attribute('longitudes'))
call tmp%add_attribute('long_name', 'longitudes')
!call tmp%add_attribute('units', Attribute('degrees_east'))
call tmp%add_attribute('units', 'degrees_east')
call ll%add_variable('lon', tmp, rc=status)
v => cs%get_variable('lev')
if (associated(v)) call ll%add_variable('lev', v, rc=status)
v => cs%get_variable('time')
call ll%add_variable('time', v, rc=status)
end associate
end subroutine add_grid_variables
subroutine add_global_attributes()
type (StringAttributeMapIterator) :: iter
type (StringAttributeMap), pointer :: attributes
character(len=:), pointer :: name
type (Attribute), pointer :: attr
associate ( ll => this%cfio_lat_lon, cs => this%cfio_cubed_sphere )
attributes => cs%get_attributes()
iter = attributes%begin()
do while (iter /= attributes%end())
name => iter%key()
attr => iter%value()
call ll%add_attribute(name, attr)
call iter%next()
end do
end associate
end subroutine add_global_attributes
subroutine add_variables()
type (StringVariableMapIterator) :: var_iter
type (StringVariableMap), pointer :: variables
character(len=:), allocatable :: ll_var_dimensions
character(len=:), pointer :: var_name
type (Variable), pointer :: cs_variable
type (StringVector), pointer :: cs_var_dimensions
type (Variable) :: ll_variable
associate ( ll => this%cfio_lat_lon, cs => this%cfio_cubed_sphere )
variables => cs%get_variables()
var_iter = variables%begin()
do while (var_iter /= variables%end())
var_name => var_iter%key()
select case (var_name)
! CS specific variables
case ('nf', 'ncontact', 'cubed_sphere', &
& 'Xdim', 'Ydim', 'lons', 'lats', &
& 'contacts', 'orientation', 'anchor', &
& 'lev', 'time')
! skip CS specific variables
case default
if (keep_var(var_name, this%requested_variables)) then
cs_variable => var_iter%value()
cs_var_dimensions => cs_variable%get_dimensions()
ll_var_dimensions = make_dim_string(cs_var_dimensions)
if (associated(this%cfio_cubed_sphere%get_variable('lev'))) then
ll_variable = Variable(type=cs_variable%get_type(), dimensions=ll_var_dimensions, &
& chunksizes = [this%IM/npx,this%JM/npy,1,1,1])
else
ll_variable = Variable(type=cs_variable%get_type(), dimensions=ll_var_dimensions, &
& chunksizes = [this%IM/npx,this%JM/npy,1,1])
end if
call transfer_attributes(from=cs_variable, to=ll_variable)
call ll%add_variable(var_name, ll_variable)
call categorize(cs_variable, var_name, variables)
end if
end select
call var_iter%next()
end do
end associate
end subroutine add_variables
subroutine transfer_attributes(from, to)
type (Variable), target, intent(in) :: from
type (Variable), target, intent(inout) :: to
type (StringAttributeMap), pointer :: attributes
type (StringAttributeMapIterator) :: attr_iter
character(len=:), pointer :: attr_name
attributes => from%get_attributes()
attr_iter = attributes%begin()
do while (attr_iter /= attributes%end())
attr_name => attr_iter%key()
select case (attr_name)
case ('grid_mapping','coordinates') ! CS specific attributes
! skip
case default
associate (val => attr_iter%value())
call to%add_attribute(attr_name, val)
end associate
end select
call attr_iter%next()
end do
end subroutine transfer_attributes
! Is variable a scalar or vector?
subroutine categorize(var, var_name, vars, rc)
type (Variable), target, intent(in) :: var
character(len=*), intent(in) :: var_name
type (StringVariableMap), target, intent(in) :: vars
integer, optional, intent(out) :: rc
type (StringAttributeMap), pointer :: attributes
type (Attribute), pointer :: long_name_attr
character(len=:), allocatable :: long_name
character(len=:), allocatable :: north_component
integer :: status
class(*), pointer :: a
attributes => var%get_attributes()
long_name_attr => attributes%at('long_name')
if (.not. associated(long_name_attr)) then
_RETURN(_SUCCESS)
end if
a => long_name_attr%get_value()
_ASSERT(associated(a),'invalid pointer')
select type (a)
type is (character(len=*))
long_name = ESMF_UtilStringLowerCase(a, rc=STATUS)
class default
_FAIL('incorrect type')
end select
if (index(long_name, 'east') > 0) then ! East component of a vector
north_component = find_north_component(vars, long_name)
_ASSERT(north_component /= '','needs informative message')
call this%vector_variables(1)%push_back(var_name)
call this%vector_variables(2)%push_back(north_component)
elseif (index(long_name, 'north') == 0) then !
call this%scalar_variables%push_back(var_name)
end if
end subroutine categorize
! For variables that have 'north' in their long name, we need to
! find the corresponding 'east' variable to properly regrid
! vector quantities. The function returns the name of the
! corresponding 'north' variable if it exists, otherwise an 0
! length string is returned.
!
! NOTE: This routine is called for all variables, not just those
! with 'north' in the long name.
!
! The logic is a bit complicated due to the use of unlimited polymorphic
! entities to store CFIO attributes. This means we need to do
! SELECT TYPE on each quantity to cast it as a string before we can
! compare.
!
function find_north_component(vars, long_name, rc) result(north_component)
character(len=:), allocatable :: north_component
type (StringVariableMap), target, intent(in) :: vars
character(len=*), intent(in) :: long_name
integer, optional, intent(out) :: rc
type (StringVariableMapIterator) :: var_iter
type (Variable), pointer :: var
type (StringAttributeMap), pointer :: attrs
type (Attribute), pointer :: attr
character(len=:), allocatable :: trial
integer :: idx
class (*), pointer :: a
north_component = '' ! unless
var_iter = vars%begin()
do while (var_iter /= vars%end())
var => var_iter%value()
attrs => var%get_attributes()
attr => attrs%at('long_name')
if (associated(attr)) then
a => attr%get_value()
_ASSERT(associated(a),'invalid pointer')
select type (a)
type is (character(len=*))
trial = ESMF_UtilStringLowerCase(a, rc=status)
class default
_FAIL('incorrect type')
end select
idx = index(trial, 'north')
if (idx /= 0) then
trial = trial(1:idx-1) // 'east' // trial(idx+5:)
if (trial == long_name) then ! success
north_component = var_iter%key()
end if
end if
end if
call var_iter%next()
end do
end function find_north_component
logical function keep_var(var_name, requested_vars)
character(len=*), intent(in) :: var_name
type (StringVector), intent(in) :: requested_vars
if (requested_vars%size() == 0) then
keep_var = .true.
else
keep_var = (requested_vars%get_index(var_name) /= 0)
end if
end function keep_var
! Convert CS dimensions of a varible into Lat-Lon dimensions.
! The former arrive as a StringVector, but this function produces
! a string of the form '<d1>,<d2>,...' to mimic the convenient form
! for the Variable() constructor.
function make_dim_string(cs_dims) result(ll_dims)
character(len=:), allocatable :: ll_dims
type (StringVector), target, intent(in) :: cs_dims
type (StringVectorIterator) :: dim_iter
character(len=:), pointer :: d
ll_dims = ''
dim_iter = cs_dims%begin()
do while (dim_iter /= cs_dims%end())
d => dim_iter%get()
select case (d)
case ('Ydim')
ll_dims = ll_dims // 'lat' // pFIO_DIMENSION_SEPARATOR
case ('Xdim')
ll_dims = ll_dims // 'lon' // pFIO_DIMENSION_SEPARATOR
case ('nf')
! skip
case default
ll_dims = ll_dims // d // pFIO_DIMENSION_SEPARATOR
end select
call dim_iter%next()
end do
end function make_dim_string
end subroutine transfer_metadata