Skip to content

Commit

Permalink
Merge pull request #3211 from GEOS-ESM/feature/bmauer/fixes-#3210
Browse files Browse the repository at this point in the history 
Feature/bmauer/fixes #3210
  • Loading branch information
@mathomp4
mathomp4 authored Dec 3, 2024
2 parents d4ff7d1 + baf3109 commit 58ddb04
Show file tree
Hide file tree
Showing 3 changed files with 145 additions and 68 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Allow update offsets of ±timestep in ExtData2G
- Minor revision (and generalization) of grid-def for GSI purposes
- Trajectory sampler: fix a bug when group_name does not exist in netCDF file and a bug that omitted the first time point
- PFIO/Variable class, new procedures to retrieve string/reals/int attributes from a variable

### Changed

Expand Down
79 changes: 11 additions & 68 deletions base/FileMetadataUtilities.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -116,30 +116,15 @@ function get_var_attr_real32(this,var_name,attr_name,rc) result(attr_real32)
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

real(REAL32) :: tmp(1)
real(REAL64) :: tmpd(1)
integer :: status
character(:), allocatable :: fname
type(Attribute), pointer :: attr
type(Variable), pointer :: var
class(*), pointer :: attr_val(:)

fname = this%get_file_name(_RC)
var => this%get_variable(var_name,_RC)
_ASSERT(associated(var),"no variable named "//var_name//" in "//fname)
attr => var%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname)
attr_val => attr%get_values()
select type(attr_val)
type is(real(kind=REAL32))
tmp = attr_val
attr_real32 = tmp(1)
type is(real(kind=REAL64))
tmpd = attr_val
attr_real32 = REAL(tmpd(1))
class default
_FAIL('unsupported subclass (not real32) for units of attribute named '//attr_name//' in '//var_name//' in '//fname)
end select
attr_real32 = var%get_attribute_real32(attr_name, rc=status)
_ASSERT(status == _SUCCESS, 'failed to get attribute named '//attr_name//' in '//var_name//' in '//fname)

_RETURN(_SUCCESS)
end function get_var_attr_real32
Expand All @@ -151,28 +136,17 @@ function get_var_attr_real64(this,var_name,attr_name,rc) result(attr_real64)
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

real(REAL64) :: tmp(1)
integer :: status
character(:), allocatable :: fname
type(Attribute), pointer :: attr
type(Variable), pointer :: var
class(*), pointer :: attr_val(:)

fname = this%get_file_name(_RC)
var => this%get_variable(var_name,_RC)
_ASSERT(associated(var),"no variable named "//var_name//" in "//fname)
attr => var%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname)
attr_val => attr%get_values()
select type(attr_val)
type is(real(kind=REAL64))
tmp = attr_val
attr_real64 = tmp(1)
class default
_FAIL('unsupported subclass (not real64) for units of attribute named '//attr_name//' in '//var_name//' in '//fname)
end select

attr_real64 = var%get_attribute_real64(attr_name, rc=status)
_ASSERT(status == _SUCCESS, 'failed to get attribute named '//attr_name//' in '//var_name//' in '//fname)
_RETURN(_SUCCESS)

end function get_var_attr_real64

function get_var_attr_int32(this,var_name,attr_name,rc) result(attr_int32)
Expand All @@ -182,26 +156,15 @@ function get_var_attr_int32(this,var_name,attr_name,rc) result(attr_int32)
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

integer(INT32) :: tmp(1)
integer :: status
character(:), allocatable :: fname
type(Attribute), pointer :: attr
type(Variable), pointer :: var
class(*), pointer :: attr_val(:)

fname = this%get_file_name(_RC)
var => this%get_variable(var_name,_RC)
_ASSERT(associated(var),"no variable named "//var_name//" in "//fname)
attr => var%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname)
attr_val => attr%get_values()
select type(attr_val)
type is(integer(kind=INT32))
tmp = attr_val
attr_int32 = tmp(1)
class default
_FAIL('unsupported subclass (not int32) for units of attribute named '//attr_name//' in '//var_name//' in '//fname)
end select
attr_int32 = var%get_attribute_int32(attr_name, rc=status)
_ASSERT(status == _SUCCESS, 'failed to get attribute named '//attr_name//' in '//var_name//' in '//fname)

_RETURN(_SUCCESS)
end function get_var_attr_int32
Expand All @@ -213,26 +176,15 @@ function get_var_attr_int64(this,var_name,attr_name,rc) result(attr_int64)
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

integer(INT64) :: tmp(1)
integer :: status
character(:), allocatable :: fname
type(Attribute), pointer :: attr
type(Variable), pointer :: var
class(*), pointer :: attr_val(:)

fname = this%get_file_name(_RC)
var => this%get_variable(var_name,_RC)
_ASSERT(associated(var),"no variable named "//var_name//" in "//fname)
attr => var%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname)
attr_val => attr%get_values()
select type(attr_val)
type is(integer(kind=INT64))
tmp = attr_val
attr_int64 = tmp(1)
class default
_FAIL('unsupported subclass (not int64) for units of attribute named '//attr_name//' in '//var_name//' in '//fname)
end select
attr_int64 = var%get_attribute_int64(attr_name, rc=status)
_ASSERT(status == _SUCCESS, 'failed to get attribute named '//attr_name//' in '//var_name//' in '//fname)

_RETURN(_SUCCESS)
end function get_var_attr_int64
Expand All @@ -246,22 +198,13 @@ function get_var_attr_string(this,var_name,attr_name,rc) result(attr_string)

integer :: status
character(:), allocatable :: fname
type(Attribute), pointer :: attr
type(Variable), pointer :: var
class(*), pointer :: attr_val

fname = this%get_file_name(_RC)
var => this%get_variable(var_name,_RC)
_ASSERT(associated(var),"no variable named "//var_name//" in "//fname)
attr => var%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname)
attr_val => attr%get_value()
select type(attr_val)
type is(character(*))
attr_string = attr_val
class default
_FAIL('unsupported subclass (not string) for units of attribute named '//attr_name//' in '//var_name//' in '//fname)
end select
attr_string = var%get_attribute_string(attr_name, rc=status)
_ASSERT(status == _SUCCESS, 'failed to get attribute named '//attr_name//' in '//var_name//' in '//fname)

_RETURN(_SUCCESS)
end function get_var_attr_string
Expand Down
133 changes: 133 additions & 0 deletions pfio/Variable.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ module pFIO_VariableMod
use pFIO_AttributeMod
use pFIO_StringAttributeMapMod
use pFIO_StringAttributeMapUtilMod
use, intrinsic :: iso_fortran_env, only: REAL32, REAL64, INT32, INT64
implicit none
private

Expand Down Expand Up @@ -40,6 +41,11 @@ module pFIO_VariableMod
procedure :: get_const_value

procedure :: get_attribute
procedure :: get_attribute_string
procedure :: get_attribute_int32
procedure :: get_attribute_int64
procedure :: get_attribute_real32
procedure :: get_attribute_real64
generic :: add_attribute => add_attribute_0d
generic :: add_attribute => add_attribute_1d
procedure :: add_attribute_0d
Expand Down Expand Up @@ -258,6 +264,133 @@ function get_attribute(this, attr_name, rc) result(attr)
_RETURN(_SUCCESS)
end function get_attribute

function get_attribute_string(this, attr_name, rc) result(attr_string)
character(len=:), allocatable :: attr_string
class (Variable), target, intent(in) :: this
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

integer :: status
type(Attribute), pointer :: attr
class(*), pointer :: attr_val

attr => this%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no such attribute "//attr_name)
attr_val => attr%get_value()
select type(attr_val)
type is(character(*))
attr_string = attr_val
class default
_FAIL('unsupported subclass (not string) of attribute named '//attr_name)
end select

_RETURN(_SUCCESS)
end function get_attribute_string

function get_attribute_real32(this,attr_name,rc) result(attr_real32)
real(REAL32) :: attr_real32
class(Variable), intent(inout) :: this
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

real(REAL32) :: tmp(1)
real(REAL64) :: tmpd(1)
integer :: status
type(Attribute), pointer :: attr
class(*), pointer :: attr_val(:)

attr => this%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no attribute named "//attr_name)
attr_val => attr%get_values()
select type(attr_val)
type is(real(kind=REAL32))
tmp = attr_val
attr_real32 = tmp(1)
type is(real(kind=REAL64))
tmpd = attr_val
attr_real32 = REAL(tmpd(1))
class default
_FAIL('unsupported subclass (not real32) for units of attribute named '//attr_name)
end select

_RETURN(_SUCCESS)
end function get_attribute_real32

function get_attribute_real64(this,attr_name,rc) result(attr_real64)
real(REAL64) :: attr_real64
class(Variable), intent(inout) :: this
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

real(REAL64) :: tmp(1)
integer :: status
type(Attribute), pointer :: attr
class(*), pointer :: attr_val(:)

attr => this%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no such attribute "//attr_name)
attr_val => attr%get_values()
select type(attr_val)
type is(real(kind=REAL64))
tmp = attr_val
attr_real64 = tmp(1)
class default
_FAIL('unsupported subclass (not real64) for units of attribute named '//attr_name)
end select

_RETURN(_SUCCESS)
end function get_attribute_real64

function get_attribute_int32(this,attr_name,rc) result(attr_int32)
integer(INT32) :: attr_int32
class(Variable), intent(inout) :: this
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

integer(INT32) :: tmp(1)
integer :: status
type(Attribute), pointer :: attr
class(*), pointer :: attr_val(:)

attr => this%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no attribute named "//attr_name)
attr_val => attr%get_values()
select type(attr_val)
type is(integer(kind=INT32))
tmp = attr_val
attr_int32 = tmp(1)
class default
_FAIL('unsupported subclass (not int32) for units of attribute named '//attr_name)
end select

_RETURN(_SUCCESS)
end function get_attribute_int32

function get_attribute_int64(this,attr_name,rc) result(attr_int64)
integer(INT64) :: attr_int64
class(Variable), intent(inout) :: this
character(len=*), intent(in) :: attr_name
integer, optional, intent(out) :: rc

integer(INT64) :: tmp(1)
integer :: status
type(Attribute), pointer :: attr
class(*), pointer :: attr_val(:)

attr => this%get_attribute(attr_name,_RC)
_ASSERT(associated(attr),"no attribute named "//attr_name)
attr_val => attr%get_values()
select type(attr_val)
type is(integer(kind=INT64))
tmp = attr_val
attr_int64 = tmp(1)
class default
_FAIL('unsupported subclass (not int64) for units of attribute named '//attr_name)
end select

_RETURN(_SUCCESS)
end function get_attribute_int64

subroutine add_const_value(this, const_value, rc)
class (Variable), target, intent(inout) :: this
type (UnlimitedEntity), intent(in) :: const_value
Expand Down

0 comments on commit 58ddb04

Please sign in to comment.