diff --git a/.circleci/config.yml b/.circleci/config.yml index c9c0f7861d39..8b900ee522ae 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -176,7 +176,8 @@ workflows: fixture_branch: feature/mathomp4/mapldevelop checkout_mapl_branch: true mepodevelop: false - rebuild_procs: 1 + rebuild_procs: 4 + build_type: Release build-and-publish-docker: when: @@ -228,8 +229,8 @@ workflows: baselibs_version: *baselibs_version container_name: mapl mpi_name: openmpi - mpi_version: 5.0.2 + mpi_version: 5.0.5 compiler_name: gcc - compiler_version: 13.2.0 + compiler_version: 14.2.0 image_name: geos-env-mkl tag_build_arg_name: *tag_build_arg_name diff --git a/CHANGELOG.md b/CHANGELOG.md index 0e9ee90c14f0..4b3173f2b8be 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,12 +9,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Added macro _RETURN(_SUCCESS) to fetch_data - 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 +- Allow lat-lon grid factory to detect and use CF compliant lat-lon bounds in a file when making a grid +- PFIO/Variable class, new procedures to retrieve string/reals/int attributes from a variable ### Changed +- Change minimum CMake version to 3.24 + - This is needed for f2py and meson support +- Refactored tableEnd check - Added commandline options to `checkpoint_benchmark.x` and `restart_benchmark.x` to allow for easier testing of different configurations. Note that the old configuration file style of input is allowed via the `--config_file` option (which overrides any other command line options) - Update ESMF version for Baselibs to match that of Spack for consistency - Update `components.yaml` @@ -27,9 +33,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - GSL 2.8 - jpeg 9f - Various build fixes - - ESMA_cmake v3.52.0 + - ESMA_cmake v3.55.0 - Fixes for using MAPL as a library in spack builds of GEOSgcm - Various backports from v4 + - Code for capturing `mepo status` output + - Fixes for f2py and meson (NOTE: Requires CMake minimum version of 3.24 in project for complete functionality) + - Fixes for `MPI_STACK` code run multiple times - Updates to CI - Use v7.27.0 Baselibs - Use GCC 14 for GNU tests @@ -38,11 +47,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fixed issue of some Baselibs builds appearing to support zstandard. This is not possible due to Baselibs building HDF5 and netCDF as static libraries +- Fixed a bug where the periodicity around the earth of the lat-lon grid was not being set properly when grid did not span from pole to pole ### Removed ### Deprecated +## [2.50.3] - 2024-12-02 + +### Fixed + +- Fixed bug where c null character is not removed from end of string when reading netcdf attribute in NetCDF4\_FileFormatter.F90 + ## [2.50.2] - 2024-10-30 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 8dc1502bdf3c..5bcfdff376b0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required (VERSION 3.23) +cmake_minimum_required (VERSION 3.24) get_property(is_multi_config GLOBAL PROPERTY GENERATOR_IS_MULTI_CONFIG) if(NOT is_multi_config AND NOT (CMAKE_BUILD_TYPE OR DEFINED ENV{CMAKE_BUILD_TYPE})) @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.50.2 + VERSION 2.50.3 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index ea8c858f7ccb..133037ce3c4a 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -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 @@ -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) @@ -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 @@ -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 @@ -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 diff --git a/base/MAPL_LatLonGridFactory.F90 b/base/MAPL_LatLonGridFactory.F90 index fbbbfe3a41e7..b7d076e5a2a3 100644 --- a/base/MAPL_LatLonGridFactory.F90 +++ b/base/MAPL_LatLonGridFactory.F90 @@ -56,6 +56,8 @@ module MAPL_LatLonGridFactoryMod integer :: px, py logical :: is_halo_initialized = .false. logical :: periodic = .true. + character(len=:), allocatable :: lon_bounds_name + character(len=:), allocatable :: lat_bounds_name contains procedure :: make_new_grid procedure :: create_basic_grid @@ -218,10 +220,16 @@ function create_basic_grid(this, unusable, rc) result(grid) integer, optional, intent(out) :: rc integer :: status + type(ESMF_PoleKind_Flag) :: polekindflag(2) _UNUSED_DUMMY(unusable) if (this%periodic) then + if (this%pole == "XY") then + polekindflag = ESMF_POLEKIND_NONE + else + polekindflag = ESMF_POLEKIND_MONOPOLE + end if grid = ESMF_GridCreate1PeriDim( & & name = this%grid_name, & & countsPerDEDim1=this%ims, & @@ -232,6 +240,7 @@ function create_basic_grid(this, unusable, rc) result(grid) & coordDep1=[1,2], & & coordDep2=[1,2], & & coordSys=ESMF_COORDSYS_SPH_RAD, & + & polekindflag=polekindflag, & & rc=status) _VERIFY(status) else @@ -673,7 +682,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi integer :: i_min, i_max real(kind=REAL64) :: d_lat, d_lat_temp, extrap_lat - logical :: is_valid, use_file_coords, compute_lons, compute_lats + logical :: is_valid, use_file_coords, compute_lons, compute_lats, has_bnds _UNUSED_DUMMY(unusable) @@ -759,6 +768,11 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi where(this%lon_centers > 180) this%lon_centers=this%lon_centers-360 end if + has_bnds = coordinate_has_bounds(file_metadata, lon_name, _RC) + if (has_bnds) then + this%lon_bounds_name = get_coordinate_bounds_name(file_metadata, lon_name, _RC) + this%lon_corners = get_coordinate_bounds(file_metadata, lon_name, _RC) + end if v => file_metadata%get_coordinate_variable(lat_name, rc=status) _VERIFY(status) @@ -773,6 +787,12 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi _FAIL('unsupported type of data; must be REAL32 or REAL64') end select + has_bnds = coordinate_has_bounds(file_metadata, lat_name, _RC) + if (has_bnds) then + this%lat_bounds_name = get_coordinate_bounds_name(file_metadata, lat_name, _RC) + this%lat_corners = get_coordinate_bounds(file_metadata, lat_name, _RC) + end if + ! Check: is this a "mis-specified" pole-centered grid? if (size(this%lat_centers) >= 4) then @@ -804,14 +824,14 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi end if end if - ! Corners are the midpoints of centers (and extrapolated at the ! poles for lats.) - allocate(this%lon_corners(im+1), this%lat_corners(jm+1)) - - this%lon_corners(1) = (this%lon_centers(im) + this%lon_centers(1))/2 - 180 - this%lon_corners(2:im) = (this%lon_centers(1:im-1) + this%lon_centers(2:im))/2 - this%lon_corners(im+1) = (this%lon_centers(im) + this%lon_centers(1))/2 + 180 + if (.not. allocated(this%lon_corners)) then + allocate(this%lon_corners(im+1)) + this%lon_corners(1) = (this%lon_centers(im) + this%lon_centers(1))/2 - 180 + this%lon_corners(2:im) = (this%lon_centers(1:im-1) + this%lon_centers(2:im))/2 + this%lon_corners(im+1) = (this%lon_centers(im) + this%lon_centers(1))/2 + 180 + end if ! This section about pole/dateline is probably not needed in file data case. if (abs(this%lon_centers(1) + 180) < 1000*epsilon(1.0)) then @@ -826,10 +846,13 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi this%dateline = 'XY' this%lon_range = RealMinMax(this%lon_centers(1), this%lon_centers(jm)) end if - - this%lat_corners(1) = this%lat_centers(1) - (this%lat_centers(2)-this%lat_centers(1))/2 - this%lat_corners(2:jm) = (this%lat_centers(1:jm-1) + this%lat_centers(2:jm))/2 - this%lat_corners(jm+1) = this%lat_centers(jm) - (this%lat_centers(jm-1)-this%lat_centers(jm))/2 + + if (.not. allocated(this%lat_corners)) then + allocate(this%lat_corners(jm+1)) + this%lat_corners(1) = this%lat_centers(1) - (this%lat_centers(2)-this%lat_centers(1))/2 + this%lat_corners(2:jm) = (this%lat_centers(1:jm-1) + this%lat_centers(2:jm))/2 + this%lat_corners(jm+1) = this%lat_centers(jm) - (this%lat_centers(jm-1)-this%lat_centers(jm))/2 + end if if (abs(this%lat_centers(1) + 90) < 1000*epsilon(1.0)) then this%pole = 'PC' @@ -1139,7 +1162,6 @@ subroutine check_and_fill_consistency(this, unusable, rc) ! Check regional vs global if (this%pole == 'XY') then ! regional - this%periodic = .false. _ASSERT(this%lat_range%min /= MAPL_UNDEFINED_REAL, 'uninitialized min for lat_range') _ASSERT(this%lat_range%max /= MAPL_UNDEFINED_REAL, 'uninitialized min for lat_range') else ! global @@ -1849,9 +1871,16 @@ function get_file_format_vars(this) result(vars) class (LatLonGridFactory), intent(inout) :: this character(len=:), allocatable :: vars + integer :: i _UNUSED_DUMMY(this) vars = 'lon,lat' + if (allocated(this%lon_bounds_name)) then + vars = vars // ',' // this%lon_bounds_name + end if + if (allocated(this%lat_bounds_name)) then + vars = vars // ',' // this%lat_bounds_name + end if end function get_file_format_vars @@ -1928,5 +1957,85 @@ function generate_file_reference3D(this,fpointer,metaData) result(ref) _UNUSED_DUMMY(metaData) end function generate_file_reference3D + function coordinate_has_bounds(metadata, coord_name, rc) result(has_bounds) + logical :: has_bounds + type(FileMetadata), intent(in) :: metadata + character(len=*), intent(in) :: coord_name + integer, optional, intent(out) :: rc + + type(Variable), pointer :: var + integer :: status + + var => metadata%get_variable(coord_name, _RC) + has_bounds = var%is_attribute_present("bounds") + + _RETURN(_SUCCESS) + end function + + function get_coordinate_bounds_name(metadata, coord_name, rc) result(coord_bounds_name) + character(len=:), allocatable :: coord_bounds_name + type(FileMetadata), intent(in) :: metadata + character(len=*), intent(in) :: coord_name + integer, optional, intent(out) :: rc + + type(Variable), pointer :: var + type(Attribute), pointer :: attr + integer :: status + class(*), pointer :: attr_val + + var => metadata%get_variable(coord_name, _RC) + attr => var%get_attribute("bounds", _RC) + attr_val => attr%get_value() + select type(attr_val) + type is(character(*)) + coord_bounds_name = attr_val + class default + _FAIL('coordinate bounds must be a string') + end select + _RETURN(_SUCCESS) + end function + + function get_coordinate_bounds(metadata, coord_name, rc) result(coord_bounds) + real(kind=REAL64), allocatable :: coord_bounds(:) + type(FileMetadata), intent(in) :: metadata + character(len=*), intent(in) :: coord_name + integer, optional, intent(out) :: rc + + type(Variable), pointer :: var + type(Attribute), pointer :: attr + integer :: status, im, i + class(*), pointer :: attr_val + character(len=:), allocatable :: bnds_name, source_file + real(kind=REAL64), allocatable :: file_bounds(:,:) + type(NetCDF4_FileFormatter) :: file_formatter + + + var => metadata%get_variable(coord_name, _RC) + attr => var%get_attribute("bounds", _RC) + attr_val => attr%get_value() + select type(attr_val) + type is(character(*)) + bnds_name = attr_val + class default + _FAIL('coordinate bounds must be a string') + end select + im = metadata%get_dimension(coord_name, _RC) + allocate(coord_bounds(im+1), _STAT) + allocate(file_bounds(2,im), _STAT) + source_file = metadata%get_source_file() + + call file_formatter%open(source_file, PFIO_READ, _RC) + call file_formatter%get_var(bnds_name, file_bounds, _RC) + call file_formatter%close(_RC) + do i=1,im-1 + _ASSERT(file_bounds(2,i)==file_bounds(1,i+1), "Bounds are not contiguous in file") + enddo + do i=1,im + coord_bounds(i) = file_bounds(1,i) + coord_bounds(i+1) = file_bounds(2,i) + enddo + + _RETURN(_SUCCESS) + end function end module MAPL_LatLonGridFactoryMod diff --git a/components.yaml b/components.yaml index 271f302b4f9d..3d65a1df9aa4 100644 --- a/components.yaml +++ b/components.yaml @@ -5,13 +5,13 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v4.31.0 + tag: v4.32.0 develop: main ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.52.0 + tag: v3.55.0 develop: develop ecbuild: diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 2ee0e4dca2fd..a868c8bd3914 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -967,24 +967,22 @@ end function get_CapGridComp_from_gc function get_vec_from_config(config, key, rc) result(vec) + type(StringVector) :: vec type(ESMF_Config), intent(inout) :: config character(len=*), intent(in) :: key integer, intent(out), optional :: rc logical :: present, tableEnd integer :: status - character(len=ESMF_MAXSTR) :: cap_import - type(StringVector) :: vec + character(len=ESMF_MAXSTR) :: value call ESMF_ConfigFindLabel(config, key//":", isPresent = present, _RC) - cap_import = "" if (present) then - - do while(trim(cap_import) /= "::") + do call ESMF_ConfigNextLine(config, tableEnd=tableEnd, _RC) if (tableEnd) exit - call ESMF_ConfigGetAttribute(config, cap_import, _RC) - if (trim(cap_import) /= "::") call vec%push_back(trim(cap_import)) + call ESMF_ConfigGetAttribute(config, value, _RC) + call vec%push_back(trim(value)) end do end if _RETURN(_SUCCESS) diff --git a/griddedio/FieldBundleRead.F90 b/griddedio/FieldBundleRead.F90 index 6f0bd2b09c65..352dd414c330 100644 --- a/griddedio/FieldBundleRead.F90 +++ b/griddedio/FieldBundleRead.F90 @@ -48,8 +48,8 @@ subroutine MAPL_create_bundle_from_metdata_id(bundle,metadata_id,file_name,only_ type(StringVariableMap), pointer :: variables type(Variable), pointer :: this_variable type(StringVariableMapIterator) :: var_iter - character(len=:), pointer :: var_name,dim_name - character(len=:), allocatable :: lev_name + character(len=:), pointer :: var_name_ptr,dim_name + character(len=:), allocatable :: lev_name,var_name type(ESMF_Field) :: field type (StringVector), pointer :: dimensions type (StringVectorIterator) :: dim_iter @@ -71,14 +71,15 @@ subroutine MAPL_create_bundle_from_metdata_id(bundle,metadata_id,file_name,only_ factory => get_factory(file_grid,rc=status) _VERIFY(status) grid_vars = factory%get_file_format_vars() - exclude_vars = grid_vars//",lev,time,lons,lats" + exclude_vars = ","//grid_vars//",lev,time,time_bnds," if (has_vertical_level) lev_size = metadata%get_dimension(trim(lev_name)) variables => metadata%get_variables() var_iter = variables%begin() do while (var_iter /= variables%end()) var_has_levels = .false. - var_name => var_iter%key() + var_name_ptr => var_iter%key() + var_name = ","//var_name_ptr//"," this_variable => var_iter%value() if (has_vertical_level) then @@ -91,20 +92,20 @@ subroutine MAPL_create_bundle_from_metdata_id(bundle,metadata_id,file_name,only_ enddo end if - if (index(','//trim(exclude_vars)//',',','//trim(var_name)//',') > 0) then + if (index(trim(exclude_vars),trim(var_name)) > 0) then call var_iter%next() cycle end if create_variable = .true. if (present(only_vars)) then - if (index(','//trim(only_vars)//',',','//trim(var_name)//',') < 1) create_variable = .false. + if (index(','//trim(only_vars)//',',trim(var_name)) < 1) create_variable = .false. end if if (create_variable) then if(var_has_levels) then if (grid_size(3) == lev_size) then location=MAPL_VLocationCenter dims = MAPL_DimsHorzVert - field= ESMF_FieldCreate(grid,name=trim(var_name),typekind=ESMF_TYPEKIND_R4, & + field= ESMF_FieldCreate(grid,name=trim(var_name_ptr),typekind=ESMF_TYPEKIND_R4, & ungriddedUbound=[grid_size(3)],ungriddedLBound=[1], rc=status) block real, pointer :: ptr3d(:,:,:) @@ -114,7 +115,7 @@ subroutine MAPL_create_bundle_from_metdata_id(bundle,metadata_id,file_name,only_ else if (grid_size(3)+1 == lev_size) then location=MAPL_VLocationEdge dims = MAPL_DimsHorzVert - field= ESMF_FieldCreate(grid,name=trim(var_name),typekind=ESMF_TYPEKIND_R4, & + field= ESMF_FieldCreate(grid,name=trim(var_name_ptr),typekind=ESMF_TYPEKIND_R4, & ungriddedUbound=[grid_size(3)],ungriddedLBound=[0], rc=status) block real, pointer :: ptr3d(:,:,:) @@ -125,7 +126,7 @@ subroutine MAPL_create_bundle_from_metdata_id(bundle,metadata_id,file_name,only_ else location=MAPL_VLocationNone dims = MAPL_DimsHorzOnly - field= ESMF_FieldCreate(grid,name=trim(var_name),typekind=ESMF_TYPEKIND_R4, & + field= ESMF_FieldCreate(grid,name=trim(var_name_ptr),typekind=ESMF_TYPEKIND_R4, & rc=status) block real, pointer :: ptr2d(:,:) @@ -137,8 +138,8 @@ subroutine MAPL_create_bundle_from_metdata_id(bundle,metadata_id,file_name,only_ _VERIFY(status) call ESMF_AttributeSet(field,name='VLOCATION',value=location,rc=status) _VERIFY(status) - units = metadata%get_var_attr_string(var_name,'units',_RC) - long_name = metadata%get_var_attr_string(var_name,'long_name',_RC) + units = metadata%get_var_attr_string(var_name_ptr,'units',_RC) + long_name = metadata%get_var_attr_string(var_name_ptr,'long_name',_RC) call ESMF_AttributeSet(field,name='UNITS',value=units,rc=status) _VERIFY(status) call ESMF_AttributeSet(field,name='LONG_NAME',value=long_name,rc=status) diff --git a/pfio/AbstractDataReference.F90 b/pfio/AbstractDataReference.F90 index 8c4a06d89597..6ec0b0f235e3 100644 --- a/pfio/AbstractDataReference.F90 +++ b/pfio/AbstractDataReference.F90 @@ -319,7 +319,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) case default _FAIL("dimension not supported yet") end select - + _RETURN(_SUCCESS) end subroutine fetch_data integer function get_length_base(this) result(length) diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index 1527d8eb5524..ca06cf590a1c 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -20,6 +20,7 @@ module pFIO_NetCDF4_FileFormatterMod use pfio_NetCDF_Supplement use netcdf use mpi + use, intrinsic :: iso_c_binding, only: C_NULL_CHAR implicit none private @@ -992,6 +993,9 @@ subroutine inq_attributes(this, cf, varid, unusable, rc) status = nf90_get_att(this%ncid, varid, trim(attr_name), str) !$omp end critical _VERIFY(status) + if (len > 0) then + if (str(len:len) == C_NULL_CHAR) str = str(1:len-1) + end if call cf%add_attribute(trim(attr_name), str) deallocate(str) case (NF90_STRING) @@ -1088,6 +1092,9 @@ subroutine inq_var_attributes(this, var, varid, unusable, rc) status = nf90_get_att(this%ncid, varid, trim(attr_name), str) !$omp end critical _VERIFY(status) + if (len > 0) then + if (str(len:len) == C_NULL_CHAR) str = str(1:len-1) + end if call var%add_attribute(trim(attr_name), str) deallocate(str) case (NF90_STRING) diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index bf2d61cd52bf..99874f729d69 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -1154,7 +1154,7 @@ subroutine get_DataFromMem( this, multi_data_read, rc) offset_address = c_loc(i_ptr(offset+1)) - call mem_data_reference%fetch_data(offset_address,q%global_count,q%start-q%global_start+1) + call mem_data_reference%fetch_data(offset_address,q%global_count,q%start-q%global_start+1, _RC) call this%insert_RequestHandle(q%request_id, & & connection%put(q%request_id, mem_data_reference)) diff --git a/pfio/Variable.F90 b/pfio/Variable.F90 index 84958a172945..001e22a92968 100644 --- a/pfio/Variable.F90 +++ b/pfio/Variable.F90 @@ -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 @@ -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 @@ -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