diff --git a/CHANGELOG.md b/CHANGELOG.md index 076033944a8c..ebb81db07b3a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -25,6 +25,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.19.2] - 2022-03-28 + +### Fixed + +- Provided workaround for GNU bug when defining file metadata in cubed-sphere grid factory (similar to Issue #1433 and its solution) + ## [2.19.1] - 2022-03-24 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index de364339a5cf..41cfb766652b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.19.1 + VERSION 2.19.2 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index 8550a1bdb786..f680ecf343fd 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -33,7 +33,7 @@ module MAPL_CubedSphereGridFactoryMod type, extends(AbstractGridFactory) :: CubedSphereGridFactory private - + character(len=:), allocatable :: grid_name integer :: grid_type = MAPL_UNDEFINED_INTEGER @@ -90,9 +90,9 @@ module MAPL_CubedSphereGridFactoryMod procedure :: decomps_are_equal procedure :: physical_params_are_equal end type CubedSphereGridFactory - + character(len=*), parameter :: MOD_NAME = 'CubedSphereGridFactory::' - + interface CubedSphereGridFactory module procedure CubedSphereGridFactory_from_parameters end interface CubedSphereGridFactory @@ -128,7 +128,7 @@ function CubedSphereGridFactory_from_parameters(unusable, grid_name, grid_type, integer, optional, intent(in) :: jms(:) ! stretched grid - real(REAL32), optional, intent(in) :: stretch_factor, target_lon, target_lat + real(REAL32), optional, intent(in) :: stretch_factor, target_lon, target_lat integer, optional, intent(out) :: rc @@ -182,7 +182,7 @@ function make_new_grid(this, unusable, rc) result(grid) end function make_new_grid - + function create_basic_grid(this, unusable, rc) result(grid) type (ESMF_Grid) :: grid class (CubedSphereGridFactory), intent(in) :: this @@ -210,7 +210,7 @@ function create_basic_grid(this, unusable, rc) result(grid) enddo if(allocated(this%jms_2d)) then - _ASSERT(size(this%jms_2d,2) == 6,'incompatible shape') + _ASSERT(size(this%jms_2d,2) == 6,'incompatible shape') allocate(jms, source = this%jms_2d) else allocate(jms(this%ny,nTile)) @@ -226,7 +226,7 @@ function create_basic_grid(this, unusable, rc) result(grid) transformArgument%target_lat=this%target_lat grid = ESMF_GridCreateCubedSPhere(this%im_world,countsPerDEDim1PTile=ims, & countsPerDEDim2PTile=jms ,name=this%grid_name, & - staggerLocList=[ESMF_STAGGERLOC_CENTER,ESMF_STAGGERLOC_CORNER], coordSys=ESMF_COORDSYS_SPH_RAD, & + staggerLocList=[ESMF_STAGGERLOC_CENTER,ESMF_STAGGERLOC_CORNER], coordSys=ESMF_COORDSYS_SPH_RAD, & transformArgs=transformArgument,rc=status) _VERIFY(status) if (this%stretch_factor/=MAPL_UNDEFINED_REAL .and. this%target_lon/=MAPL_UNDEFINED_REAL .and. & @@ -287,7 +287,7 @@ function create_basic_grid(this, unusable, rc) result(grid) _RETURN(_SUCCESS) end function create_basic_grid - + subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_file_coordinates, rc) use MAPL_KeywordEnforcerMod use MAPL_BaseMod, only: MAPL_DecomposeDim @@ -351,7 +351,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi _ASSERT(.false.,'unsupport subclass for stretch params') end select end if - + hasLev=.false. hasLevel=.false. @@ -432,7 +432,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _VERIFY(status) ! halo initialization - + call ESMF_VmGet(VM, mpicommunicator=vmcomm, petCount=ndes, rc=status) _VERIFY(status) @@ -440,7 +440,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _RETURN(_SUCCESS) contains - + subroutine get_multi_integer(values, label, rc) integer, allocatable, intent(out) :: values(:) character(len=*) :: label @@ -451,7 +451,7 @@ subroutine get_multi_integer(values, label, rc) integer :: tmp integer :: status logical :: isPresent - + call ESMF_ConfigFindLabel(config, label=prefix//label,isPresent=isPresent,rc=status) _VERIFY(status) if (.not. isPresent) then @@ -494,7 +494,7 @@ subroutine get_jms_from_file(values, file_name, n, rc) integer :: status, N_proc,NF integer, allocatable :: values_tmp(:), values_(:,:) - + N_proc = n*6 ! it has been devided by 6. get back the original NY allocate(values_tmp(N_proc), stat=status) ! no point in checking status _VERIFY(status) @@ -534,7 +534,7 @@ subroutine get_jms_from_file(values, file_name, n, rc) face = face + values_tmp(k) k = k+1 if (face == this%im_world) exit - enddo + enddo enddo values = values_ @@ -551,7 +551,7 @@ subroutine get_bounds(bounds, label, rc) integer :: n integer :: status logical :: isPresent - + call ESMF_ConfigFindLabel(config, label=prefix//label,isPresent=isPresent,rc=status) _VERIFY(status) if (.not. isPresent) then @@ -568,9 +568,9 @@ subroutine get_bounds(bounds, label, rc) end subroutine get_bounds - + end subroutine initialize_from_config_with_prefix - + subroutine halo_init(this, halo_width,rc) class (CubedSphereGridFactory), intent(inout) :: this integer, optional, intent(in) :: halo_width @@ -602,7 +602,7 @@ subroutine halo_init(this, halo_width,rc) _VERIFY(status) call ESMF_FieldDestroy(field,rc=status) _VERIFY(status) - + end subroutine halo_init function to_string(this) result(string) @@ -649,14 +649,14 @@ subroutine check_and_fill_consistency(this, unusable, rc) !_ASSERT(allocated(this%ims) .eqv. allocated(this%jms),'inconsistent options') call verify(this%nx, this%im_world, this%ims, rc=status) if (allocated(this%jms_2d)) then - _ASSERT(size(this%jms_2d,2)==6, 'incompatible shape') + _ASSERT(size(this%jms_2d,2)==6, 'incompatible shape') _ASSERT(sum(this%jms_2d) == 6*this%im_world, 'incompatible shape') else call verify(this%ny, this%im_world, this%jms, rc=status) endif - + _RETURN(_SUCCESS) - + contains subroutine verify(n, m_world, ms, rc) @@ -704,52 +704,52 @@ elemental subroutine set_with_default_integer(to, from, default) integer, intent(out) :: to integer, optional, intent(in) :: from integer, intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_integer - + elemental subroutine set_with_default_real64(to, from, default) real(REAL64), intent(out) :: to real(REAL64), optional, intent(in) :: from real(REAL64), intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_real64 - + elemental subroutine set_with_default_real(to, from, default) real, intent(out) :: to real, optional, intent(in) :: from real, intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_real - + subroutine set_with_default_character(to, from, default) character(len=:), allocatable, intent(out) :: to character(len=*), optional, intent(in) :: from character(len=*), intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_character @@ -757,15 +757,15 @@ elemental subroutine set_with_default_bounds(to, from, default) type (RealMinMax), intent(out) :: to type (RealMinMax), optional, intent(in) :: from type (RealMinMax), intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_bounds - + function decomps_are_equal(this, a) result(equal) class (CubedSphereGridFactory), intent(in) :: this class (AbstractGridFactory), intent(in) :: a @@ -781,7 +781,7 @@ function decomps_are_equal(this, a) result(equal) if (.not. equal) return equal = size(a%jms) == size(this%jms) if (.not. equal) return - equal = all(a%ims == this%ims) + equal = all(a%ims == this%ims) if (.not. equal) return if ( allocated(a%jms) .and. allocated(this%jms)) then @@ -795,7 +795,7 @@ function decomps_are_equal(this, a) result(equal) equal = all(a%jms_2d == this%jms_2d) if (.not. equal) return endif - end select + end select end function decomps_are_equal @@ -813,18 +813,18 @@ function physical_params_are_equal(this, a) result(equal) equal = (a%im_world == this%im_world) if (.not. equal) return - + equal = (a%stretch_factor == this%stretch_factor) if (.not. equal) return - + equal = (a%target_lon == this%target_lon) if (.not. equal) return - + equal = (a%target_lat == this%target_lat) if (.not. equal) return - + end select - + end function physical_params_are_equal logical function equals(a, b) @@ -843,12 +843,12 @@ logical function equals(a, b) equals = a%decomps_are_equal(b) if (.not. equals) return - + equals = a%physical_params_are_equal(b) if (.not. equals) return - + end select - + end function equals subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, unusable, rc) @@ -866,7 +866,7 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, _UNUSED_DUMMY(lon_array) _UNUSED_DUMMY(lat_array) _UNUSED_DUMMY(unusable) - + _FAIL('not implemented') end subroutine initialize_from_esmf_distGrid @@ -887,7 +887,7 @@ subroutine halo(this, array, unusable, halo_width, rc) integer :: useableHalo_width _UNUSED_DUMMY(unusable) - + if (.not. this%halo_initialized) then call this%halo_init(halo_width = halo_width) this%halo_initialized = .true. @@ -912,7 +912,7 @@ subroutine halo(this, array, unusable, halo_width, rc) array = ptr call ESMF_FieldDestroy(field,rc=status) _VERIFY(status) - + _RETURN(_SUCCESS) end subroutine halo @@ -943,6 +943,8 @@ subroutine append_metadata(this, metadata)!, unusable, rc) integer, allocatable :: ivar(:,:) integer, allocatable :: ivar2(:,:,:) + real(REAL64), allocatable :: temp_coords(:) + integer :: status integer, parameter :: ncontact = 4 integer, parameter :: nf = 6 @@ -960,12 +962,16 @@ subroutine append_metadata(this, metadata)!, unusable, rc) v = Variable(type=PFIO_REAL64, dimensions='Xdim') call v%add_attribute('long_name', 'Fake Longitude for GrADS Compatibility') call v%add_attribute('units', 'degrees_east') - call metadata%add_variable('Xdim', CoordinateVariable(v, this%get_fake_longitudes())) + temp_coords = this%get_fake_longitudes() + call metadata%add_variable('Xdim', CoordinateVariable(v, temp_coords)) + deallocate(temp_coords) v = Variable(type=PFIO_REAL64, dimensions='Ydim') call v%add_attribute('long_name', 'Fake Latitude for GrADS Compatibility') call v%add_attribute('units', 'degrees_north') - call metadata%add_variable('Ydim', CoordinateVariable(v, this%get_fake_latitudes())) + temp_coords = this%get_fake_latitudes() + call metadata%add_variable('Ydim', CoordinateVariable(v, temp_coords)) + deallocate(temp_coords) v = Variable(type=PFIO_INT32, dimensions='nf') call v%add_attribute('long_name','cubed-sphere face') @@ -1007,7 +1013,7 @@ subroutine append_metadata(this, metadata)!, unusable, rc) im = this%im_world allocate(ivar2(4,4,6)) - ivar2 = reshape( & + ivar2 = reshape( & [[im, im, 1, im, & 1, im, 1, 1, & 1, im, 1, 1, & @@ -1125,11 +1131,11 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) integer :: j_mid integer :: tile integer :: status - + character(len=*), parameter :: Iam = MOD_NAME // 'get_fake_longitudes()' - + _UNUSED_DUMMY(unusable) - + grid = this%make_grid() call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, & @@ -1142,7 +1148,7 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) call ESMF_VMGet(vm, mpiCommunicator=comm_grid, petcount=npes, localpet=pet, rc=status) _VERIFY(status) - + call MAPL_grid_interior(grid, i_1, i_n, j_1, j_n) j_mid = 1 + this%im_world/2 @@ -1159,7 +1165,7 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) end if allocate(counts(0:npes-1), displs(0:npes-1)) - + call MPI_Allgather(n_loc, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, comm_grid, ierror) _VERIFY(ierror) @@ -1173,7 +1179,7 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) _VERIFY(ierror) longitudes = longitudes * MAPL_RADIANS_TO_DEGREES - + end function get_fake_longitudes function get_fake_latitudes(this, unusable, rc) result(latitudes) @@ -1197,11 +1203,11 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) integer :: j_mid integer :: tile integer :: status - + character(len=*), parameter :: Iam = MOD_NAME // 'get_fake_latitudes()' _UNUSED_DUMMY(unusable) - + grid = this%make_grid() call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & @@ -1214,7 +1220,7 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) call ESMF_VMGet(vm, mpiCommunicator=comm_grid, petcount=npes, localpet=pet, rc=status) _VERIFY(status) - + call MAPL_grid_interior(grid, i_1, i_n, j_1, j_n) j_mid = 1 + this%im_world/2 @@ -1231,7 +1237,7 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) end if allocate(counts(0:npes-1), displs(0:npes-1)) - + call MPI_Allgather(n_loc, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, comm_grid, ierror) _VERIFY(ierror) @@ -1245,7 +1251,7 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) _VERIFY(ierror) latitudes = latitudes * MAPL_RADIANS_TO_DEGREES - + end function get_fake_latitudes subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,metaData,rc)