diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 370448e57a90..d16d06554f12 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -6,6 +6,7 @@ on: # Do not run if the only files changed cannot affect the build paths-ignore: - "**.md" + - "**.json" - "Python/**" - ".github/CODEOWNERS" - ".github/PULL_REQUEST_TEMPLATE.md" diff --git a/.gitignore b/.gitignore index bc51d4ad236c..d51c0ed63e21 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ /ESMA_env@/ /.mepo/ *.py.bak +CMakeUserPresets.json diff --git a/CHANGELOG.md b/CHANGELOG.md index 06f96bad844f..e9d5b5d36671 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,28 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed ### Fixed +## [2.8.1] - 2021-07-28 + +### Removed + +- Removed MAPL_OldCubedShereGridFactory.F90 and consilidated with MAPL_CubedSphereGridFactory.F90 + +### Added + +- Add stretch parameters to restarts and check the file grid compared to MAPL grid + when reading restarts +- Add `CMakePresets.json` file + - Note: requires CMake 3.21.0 to use + - Per CMake advice, add `CMakeUserPresets.json` to `.gitignore` + +### Changed + +- Widened the throughput timer format + +### Fixed + +- Fixed bug with tripolar grids and restarts to not check the file grid matches the application grid if application grid is tripolar + ## [2.8.0] - 2021-07-12 ### Added diff --git a/CMakeLists.txt b/CMakeLists.txt index 4e6e513b942a..e3d1d19bc946 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.8.0 + VERSION 2.8.1 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # mepo can now clone subrepos in three styles diff --git a/CMakePresets.json b/CMakePresets.json new file mode 100644 index 000000000000..b616a275677f --- /dev/null +++ b/CMakePresets.json @@ -0,0 +1,126 @@ +{ + "version": 3, + "cmakeMinimumRequired": { + "major": 3, + "minor": 21, + "patch": 0 + }, + "configurePresets": [ + { + "name": "base-configure", + "hidden": true, + "displayName": "Base Configure Settings", + "description": "Sets build and install directories", + "binaryDir": "${sourceDir}/build-${presetName}", + "cacheVariables": { + "BASEDIR": "$env{BASEDIR}", + "CMAKE_INSTALL_PREFIX": "${sourceDir}/install-${presetName}", + "CMAKE_BUILD_TYPE": "${presetName}" + } + }, + { + "name": "base-gnu", + "hidden": true, + "inherits": "base-configure", + "displayName": "Base GNU Make Config", + "description": "Sets GNU Make generator", + "generator": "Unix Makefiles" + }, + { + "name": "base-ninja", + "hidden": true, + "inherits": "base-configure", + "displayName": "Base Ninja Config", + "description": "Sets Ninja generator", + "generator": "Ninja" + }, + { + "name": "Release", + "inherits": "base-gnu", + "displayName": "Release Configure", + "description": "Release build using GNU Make generator" + }, + { + "name": "Debug", + "inherits": "base-gnu", + "displayName": "Debug Configure", + "description": "Debug build using GNU Make generator" + }, + { + "name": "Aggressive", + "inherits": "base-gnu", + "displayName": "Aggressive Configure", + "description": "Aggressive build using GNU Make generator" + }, + { + "name": "Release-Ninja", + "inherits": "base-ninja", + "displayName": "Release Ninja Configure", + "description": "Release build using Ninja generator" + }, + { + "name": "Debug-Ninja", + "inherits": "base-ninja", + "displayName": "Debug Ninja Configure", + "description": "Debug build using Ninja generator" + }, + { + "name": "Aggressive-Ninja", + "inherits": "base-ninja", + "displayName": "Aggressive Ninja Configure", + "description": "Aggressive build using Ninja generator" + } + ], + "buildPresets": [ + { + "name": "base-build", + "hidden": true, + "displayName": "Base Build Config", + "description": "Sets default build options", + "jobs": 6, + "targets": ["install"] + }, + { + "name": "Release", + "configurePreset": "Release", + "inherits": "base-build", + "displayName": "Release Build", + "description": "Release build using GNU Make generator" + }, + { + "name": "Debug", + "configurePreset": "Debug", + "inherits": "base-build", + "displayName": "Debug Build", + "description": "Debug build using GNU Make generator" + }, + { + "name": "Aggressive", + "configurePreset": "Aggressive", + "inherits": "base-build", + "displayName": "Aggressive Build", + "description": "Aggressive build using GNU Make generator" + }, + { + "name": "Release-Ninja", + "configurePreset": "Release-Ninja", + "inherits": "base-build", + "displayName": "Release Ninja Build", + "description": "Release build using Ninja generator" + }, + { + "name": "Debug-Ninja", + "configurePreset": "Debug-Ninja", + "inherits": "base-build", + "displayName": "Debug Ninja Build", + "description": "Debug build using Ninja generator" + }, + { + "name": "Aggressive-Ninja", + "configurePreset": "Aggressive-Ninja", + "inherits": "base-build", + "displayName": "Aggressive Ninja Build", + "description": "Aggressive build using Ninja generator" + } + ] +} diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 8ce83eb28f9a..df1b2a48c4bc 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -43,7 +43,7 @@ set (srcs MAPL_ExtDataGridCompMod.F90 MAPL_OrbGridCompMod.F90 MAPL_LocStreamFactoryMod.F90 MAPL_LocstreamRegridder.F90 MAPL_ExternalGridFactory.F90 - ServerManager.F90 ApplicationSupport.F90 MAPL_OldCubedSphereGridFactory.F90 + ServerManager.F90 ApplicationSupport.F90 regex_module.F90 StringTemplate.F90 MAPL_SphericalGeometry.F90 FieldBundleWrite.F90 FieldBundleRead.F90 regex_F.c c_mapl_locstream_F.c getrss.c memuse.c diff --git a/base/MAPL_AbstractGridFactory.F90 b/base/MAPL_AbstractGridFactory.F90 index 5fe8fe03e4c0..a83b41fed7f0 100644 --- a/base/MAPL_AbstractGridFactory.F90 +++ b/base/MAPL_AbstractGridFactory.F90 @@ -79,6 +79,8 @@ module MAPL_AbstractGridFactoryMod procedure(generate_file_reference2D), deferred :: generate_file_reference2D procedure(generate_file_reference3D), deferred :: generate_file_reference3D procedure(get_file_format_vars), deferred :: get_file_format_vars + procedure(decomps_are_equal), deferred :: decomps_are_equal + procedure(physical_params_are_equal), deferred :: physical_params_are_equal end type AbstractGridFactory abstract interface @@ -89,6 +91,18 @@ logical function equals(a, b) class (AbstractGridFactory), intent(in) :: b end function equals + logical function decomps_are_equal(this,a) + import AbstractGridFactory + class (AbstractGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + end function decomps_are_equal + + logical function physical_params_are_equal(this,a) + import AbstractGridFactory + class (AbstractGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + end function physical_params_are_equal + function make_new_grid(this, unusable, rc) result(grid) use esmf use MAPL_KeywordEnforcerMod @@ -180,14 +194,16 @@ subroutine append_variable_metadata(this,var) type(Variable), intent(inout) :: var end subroutine append_variable_metadata - subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,metadata,rc) use esmf + use pFIO import AbstractGridFactory class (AbstractGridFactory), intent(inout) :: this type(ESMF_Grid), intent(inout) :: grid integer, allocatable, intent(out) :: local_start(:) integer, allocatable, intent(out) :: global_start(:) integer, allocatable, intent(out) :: global_count(:) + type(FileMetadata), intent(in), optional :: metaData integer, optional, intent(out) :: rc end subroutine generate_file_bounds @@ -212,12 +228,13 @@ function generate_file_reference2D(this,fpointer) result(ref) real, pointer, intent(in) :: fpointer(:,:) end function generate_file_reference2D - function generate_file_reference3D(this,fpointer) result(ref) + function generate_file_reference3D(this,fpointer,metadata) result(ref) use pFIO import AbstractGridFactory type(ArrayReference) :: ref class (AbstractGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:,:) + type(FileMetadata), intent(in), optional :: metaData end function generate_file_reference3D end interface @@ -1013,6 +1030,5 @@ function get_grid(this, unusable, rc) result(grid) end if end function get_grid - end module MAPL_AbstractGridFactoryMod diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index e5e820084c45..58c8ee270786 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -93,6 +93,8 @@ module MAPL_CubedSphereGridFactoryMod procedure :: generate_file_reference3D procedure :: get_fake_longitudes procedure :: get_fake_latitudes + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type CubedSphereGridFactory character(len=*), parameter :: MOD_NAME = 'CubedSphereGridFactory::' @@ -233,12 +235,15 @@ function create_basic_grid(this, unusable, rc) result(grid) staggerLocList=[ESMF_STAGGERLOC_CENTER,ESMF_STAGGERLOC_CORNER], coordSys=ESMF_COORDSYS_SPH_RAD, & transformArgs=transformArgument,rc=status) _VERIFY(status) - call ESMF_AttributeSet(grid, name='STRETCH_FACTOR', value=this%stretch_factor,rc=status) - _VERIFY(status) - call ESMF_AttributeSet(grid, name='TARGET_LON', value=this%target_lon,rc=status) - _VERIFY(status) - call ESMF_AttributeSet(grid, name='TARGET_LAT', value=this%target_lat,rc=status) - _VERIFY(status) + if (this%stretch_factor/=UNDEFINED_REAL .and. this%target_lon/=UNDEFINED_REAL .and. & + this%target_lat/=UNDEFINED_REAL) then + call ESMF_AttributeSet(grid, name='STRETCH_FACTOR', value=this%stretch_factor,rc=status) + _VERIFY(status) + call ESMF_AttributeSet(grid, name='TARGET_LON', value=this%target_lon,rc=status) + _VERIFY(status) + call ESMF_AttributeSet(grid, name='TARGET_LAT', value=this%target_lat,rc=status) + _VERIFY(status) + end if else grid = ESMF_GridCreateCubedSPhere(this%im_world,countsPerDEDim1PTile=ims, & countsPerDEDim2PTile=jms ,name=this%grid_name, & @@ -301,16 +306,59 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi character(len=*), parameter :: Iam= MOD_NAME // 'initialize_from_file_metadata()' integer :: status - logical :: hasLev,hasLevel + logical :: hasLev,hasLevel,hasXdim,hasLon + logical :: is_stretched character(:), allocatable :: lev_name + type(Attribute), pointer :: attr + class(*), pointer :: attr_val(:) associate(im => this%im_world) - im = file_metadata%get_dimension('Xdim',rc=status) - _VERIFY(status) + hasXdim = file_metadata%has_dimension('Xdim') + hasLon = file_metadata%has_dimension('lon',rc=status) + if (hasXdim .and. (.not.haslon)) then + im = file_metadata%get_dimension('Xdim',rc=status) + _VERIFY(status) + else if (hasLon .and. (.not.hasXdim)) then + im = file_metadata%get_dimension('lon',rc=status) + _VERIFY(status) + else + _ASSERT(.false.,"can not identify dimenions of cubed-sphere file") + end if end associate call this%make_arbitrary_decomposition(this%nx, this%ny, reduceFactor=6, rc=status) _VERIFY(status) + is_stretched = file_metadata%has_attribute('STRETCH_FACTOR') .and. & + file_metadata%has_attribute('TARGET_LON') .and. & + file_metadata%has_attribute('TARGET_LAT') + if (is_stretched) then + attr => file_metadata%get_attribute('STRETCH_FACTOR') + attr_val => attr%get_values() + select type(q=>attr_val) + type is (real(kind=REAL32)) + this%stretch_factor = q(1) + class default + _ASSERT(.false.,'unsupport subclass for stretch params') + end select + attr => file_metadata%get_attribute('TARGET_LAT') + attr_val => attr%get_values() + select type(q=>attr_val) + type is (real(kind=REAL32)) + this%target_lon = q(1) + class default + _ASSERT(.false.,'unsupport subclass for stretch params') + end select + attr => file_metadata%get_attribute('TARGET_LON') + attr_val => attr%get_values() + select type(q=>attr_val) + type is (real(kind=REAL32)) + this%target_lat = q(1) + class default + _ASSERT(.false.,'unsupport subclass for stretch params') + end select + end if + + hasLev=.false. hasLevel=.false. lev_name = 'lev' @@ -723,10 +771,67 @@ elemental subroutine set_with_default_bounds(to, from, default) end subroutine set_with_default_bounds + function decomps_are_equal(this, a) result(equal) + class (CubedSphereGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + integer :: a_nx,b_nx,a_ny,b_ny + logical :: equal + + select type(a) + class default + equal = .false. + class is (CubedSphereGridFactory) + equal = .true. + equal = all(a%ims == this%ims) + if (.not. equal) return + + if ( allocated(a%jms) .and. allocated(this%jms)) then + a_ny=size(a%jms) + b_ny=size(this%ims) + a_nx=size(a%ims) + b_nx=size(this%ims) + equal = a_nx*a_ny == b_nx*b_ny + if (.not. equal) return + else + equal = all(a%jms_2d == this%jms_2d) + if (.not. equal) return + endif + end select + + end function decomps_are_equal + + function physical_params_are_equal(this, a) result(equal) + class (CubedSphereGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal + + select type (a) + class default + equal = .false. + return + class is (CubedSphereGridFactory) + equal = .true. + + 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) class (CubedSphereGridFactory), intent(in) :: a class (AbstractGridFactory), intent(in) :: b + integer :: a_nx,b_nx,a_ny,b_ny select type (b) class default @@ -735,23 +840,14 @@ logical function equals(a, b) class is (CubedSphereGridFactory) equals = .true. - equals = (a%im_world == b%im_world) - if (.not. equals) return - equals = (a%lm == b%lm) if (.not. equals) return + + equals = a%decomps_are_equal(b) + if (.not. equals) return - ! same decomposition - equals = all(a%ims == b%ims) + equals = a%physical_params_are_equal(b) if (.not. equals) return - - if ( allocated(a%jms) .and. allocated(b%jms)) then - equals = all(a%jms == b%jms) - if (.not. equals) return - else - equals = all(a%jms_2d == b%jms_2d) - if (.not. equals) return - endif end select @@ -1153,27 +1249,46 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) end function get_fake_latitudes - subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,metaData,rc) use MAPL_BaseMod class(CubedSphereGridFactory), intent(inout) :: this type(ESMF_Grid), intent(inout) :: grid integer, allocatable, intent(out) :: local_start(:) integer, allocatable, intent(out) :: global_start(:) integer, allocatable, intent(out) :: global_count(:) + type(FileMetadata), intent(in), optional :: metaData integer, optional, intent(out) :: rc integer :: status integer :: global_dim(3),i1,j1,in,jn,tile character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' + logical :: face_format + integer :: nf _UNUSED_DUMMY(this) + if (present(metadata)) then + nf = metadata%get_dimension('nf',rc=status) + if (status == _SUCCESS) then + face_format = .true. + else + face_format = .false. + end if + else + face_format = .true. + end if call MAPL_GridGet(grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) call MAPL_GridGetInterior(grid,i1,in,j1,jn) - tile = 1 + (j1-1)/global_dim(1) - allocate(local_start,source=[i1,j1-(tile-1)*global_dim(1),tile]) - allocate(global_start,source=[1,1,1]) - allocate(global_count,source=[global_dim(1),global_dim(1),6]) + if (face_format) then + tile = 1 + (j1-1)/global_dim(1) + allocate(local_start,source=[i1,j1-(tile-1)*global_dim(1),tile]) + allocate(global_start,source=[1,1,1]) + allocate(global_count,source=[global_dim(1),global_dim(1),6]) + else + allocate(local_start,source=[i1,j1]) + allocate(global_start,source=[1,1]) + allocate(global_count,source=[global_dim(1),global_dim(2)]) + end if _RETURN(_SUCCESS) @@ -1191,6 +1306,7 @@ subroutine generate_file_corner_bounds(this,grid,local_start,global_start,global integer :: status integer :: global_dim(3),i1,j1,in,jn,tile integer :: face_i1, face_j1, is, js + integer :: nf character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' _UNUSED_DUMMY(this) @@ -1219,18 +1335,37 @@ function generate_file_reference2D(this,fpointer) result(ref) ref = ArrayReference(fpointer) end function generate_file_reference2D - function generate_file_reference3D(this,fpointer) result(ref) + function generate_file_reference3D(this,fpointer,metadata) result(ref) use pFIO use, intrinsic :: ISO_C_BINDING type(ArrayReference) :: ref class(CubedSphereGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:,:) + type(FileMetadata), intent(in), optional :: metaData type(c_ptr) :: cptr real, pointer :: ptr_ref(:,:,:,:,:) + logical :: face_format + integer :: nf,status _UNUSED_DUMMY(this) - cptr = c_loc(fpointer) - call C_F_pointer(cptr,ptr_ref,[size(fpointer,1),size(fpointer,2),1,size(fpointer,3),1]) - ref = ArrayReference(ptr_ref) + + if (present(metadata)) then + nf = metadata%get_dimension('nf',rc=status) + if (status == _SUCCESS) then + face_format = .true. + else + face_format = .false. + end if + else + face_format = .true. + end if + + if (face_format) then + cptr = c_loc(fpointer) + call C_F_pointer(cptr,ptr_ref,[size(fpointer,1),size(fpointer,2),1,size(fpointer,3),1]) + ref = ArrayReference(ptr_ref) + else + ref = ArrayReference(fpointer) + end if end function generate_file_reference3D - + end module MAPL_CubedSphereGridFactoryMod diff --git a/base/MAPL_ExternalGridFactory.F90 b/base/MAPL_ExternalGridFactory.F90 index fb3fa5881806..9182156c335e 100644 --- a/base/MAPL_ExternalGridFactory.F90 +++ b/base/MAPL_ExternalGridFactory.F90 @@ -44,6 +44,8 @@ module MAPL_ExternalGridFactoryMod procedure :: generate_file_corner_bounds procedure :: generate_file_reference2D procedure :: generate_file_reference3D + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type ExternalGridFactory interface ExternalGridFactory @@ -105,6 +107,36 @@ function make_new_grid(this, unusable, rc) result(grid) _RETURN(_SUCCESS) end function make_new_grid + function decomps_are_equal(this,a) result(equal) + class(ExternalGridFactory), intent(in) :: this + class(AbstractGridFactory), intent(in) :: a + logical :: equal + + _UNUSED_DUMMY(this) + select type(a) + class default + equal = .false. + return + class is (ExternalGridFactory) + equal = .true. + end select + end function decomps_are_equal + + function physical_params_are_equal(this,a) result(equal) + class(ExternalGridFactory), intent(in) :: this + class(AbstractGridFactory), intent(in) :: a + logical :: equal + + _UNUSED_DUMMY(this) + select type(a) + class default + equal = .false. + return + class is (ExternalGridFactory) + equal = .true. + end select + end function physical_params_are_equal + logical function equals(a, b) class(ExternalGridFactory), intent(in) :: a class(AbstractGridFactory), intent(in) :: b @@ -238,12 +270,13 @@ subroutine append_variable_metadata(this, var) ! TODO: fill in the rest end subroutine append_variable_metadata - subroutine generate_file_bounds(this, grid, local_start, global_start, global_count, rc) + subroutine generate_file_bounds(this, grid, local_start, global_start, global_count, metadata, rc) class(ExternalGridFactory), intent(inout) :: this type(ESMF_Grid), intent(inout) :: grid integer, allocatable, intent( out) :: local_start(:) integer, allocatable, intent( out) :: global_start(:) integer, allocatable, intent( out) :: global_count(:) + type(FileMetaData), intent(in), optional :: metaData integer, optional, intent( out) :: rc character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' @@ -287,10 +320,11 @@ function generate_file_reference2D(this, fpointer) result(ref) ref = ArrayReference(fpointer) end function generate_file_reference2D - function generate_file_reference3D(this, fpointer) result(ref) + function generate_file_reference3D(this, fpointer, metadata) result(ref) type(ArrayReference) :: ref class(ExternalGridFactory), intent(inout) :: this real, pointer, intent(in ) :: fpointer(:,:,:) + type(FileMetaData), intent(in), optional :: metaData _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) diff --git a/base/MAPL_Generic.F90 b/base/MAPL_Generic.F90 index 04e6959dd8fb..6761f45e2731 100644 --- a/base/MAPL_Generic.F90 +++ b/base/MAPL_Generic.F90 @@ -127,6 +127,8 @@ module MAPL_GenericMod use mpi use netcdf use pFlogger, only: logging, Logger + use MAPL_AbstractGridFactoryMod + use MAPL_GridManagerMod, only: grid_manager,get_factory use, intrinsic :: ISO_C_BINDING use, intrinsic :: iso_fortran_env, only: REAL32, REAL64, int32, int64 use, intrinsic :: iso_fortran_env, only: OUTPUT_UNIT @@ -5652,6 +5654,10 @@ subroutine MAPL_ESMFStateReadFromFile(STATE,CLOCK,FILENAME,MPL,HDR,RC) character(len=ESMF_MAXSTR) :: FileType integer :: isNC4 logical :: isPresent + logical :: is_tile + class(AbstractGridFactory), pointer :: app_factory + class (AbstractGridFactory), allocatable :: file_factory + character(len=ESMF_MAXSTR) :: grid_type _UNUSED_DUMMY(CLOCK) @@ -5893,6 +5899,17 @@ subroutine MAPL_ESMFStateReadFromFile(STATE,CLOCK,FILENAME,MPL,HDR,RC) call ArrDescrSetNCPar(arrdes,MPL,tile=.TRUE.,num_readers=mpl%grid%num_readers,RC=STATUS) _VERIFY(STATUS) else + call ESMF_AttributeGet(MPL%GRID%ESMFGRID,'GridType',isPresent=isPresent,rc=status) + _VERIFY(status) + if (isPresent) then + call ESMF_AttributeGet(MPL%GRID%ESMFGRID,'GridType',value=grid_type,rc=status) + _VERIFY(status) + end if + if (trim(grid_type) /= 'Tripolar' .and. trim(grid_type) /= 'llc' .and. trim(grid_type) /= 'External') then + app_factory => get_factory(MPL%GRID%ESMFGRID) + allocate(file_factory,source=grid_manager%make_factory(trim(filename))) + _ASSERT(file_factory%physical_params_are_equal(app_factory),"Factories not equal") + end if call ArrDescrSetNCPar(arrdes,MPL,num_readers=mpl%grid%num_readers,RC=STATUS) _VERIFY(STATUS) end if PNC4_TILE @@ -9921,7 +9938,6 @@ end subroutine MAPL_GenericMakeXchgNatural subroutine MAPL_GridCreate(GC, MAPLOBJ, ESMFGRID, srcGC, rc) - use MAPL_GridManagerMod, only: grid_manager type(ESMF_GridComp), optional, intent(INOUT) :: GC type (MAPL_MetaComp),optional, target, intent(INOUT) :: MAPLOBJ type (ESMF_Grid), optional, intent( OUT) :: ESMFGRID diff --git a/base/MAPL_GridManager.F90 b/base/MAPL_GridManager.F90 index cb638407d8f7..ae865b1ac580 100644 --- a/base/MAPL_GridManager.F90 +++ b/base/MAPL_GridManager.F90 @@ -87,7 +87,7 @@ function make_clone(this, grid_type, unusable, rc) result(factory) use MAPL_TripolarGridFactoryMod, only: TripolarGridFactory use MAPL_LlcGridFactoryMod, only: LlcGridFactory use MAPL_ExternalGridFactoryMod, only: ExternalGridFactory - use MAPL_OldCubedSphereGridFactoryMod, only: OldCubedSphereGridFactory + !use MAPL_OldCubedSphereGridFactoryMod, only: OldCubedSphereGridFactory class (AbstractGridFactory), allocatable :: factory class (GridManager), intent(inout) :: this character(len=*), intent(in) :: grid_type @@ -107,7 +107,7 @@ function make_clone(this, grid_type, unusable, rc) result(factory) logical, save :: initialized = .false. type (LatLonGridFactory) :: latlon_factory type (CubedSphereGridFactory) :: cubed_factory - type (OldCubedSphereGridFactory) :: old_cubed_factory + !type (OldCubedSphereGridFactory) :: old_cubed_factory type (TripolarGridFactory) :: tripolar_factory type (LlcGridFactory) :: llc_factory type (ExternalGridFactory) :: external_factory @@ -117,7 +117,7 @@ function make_clone(this, grid_type, unusable, rc) result(factory) if (.not. initialized) then call this%prototypes%insert('LatLon', latlon_factory) call this%prototypes%insert('Cubed-Sphere', cubed_factory) - call this%prototypes%insert('Old-Cubed-Sphere', old_cubed_factory) + !call this%prototypes%insert('Old-Cubed-Sphere', old_cubed_factory) call this%prototypes%insert('Tripolar', tripolar_factory) call this%prototypes%insert('llc', llc_factory) call this%prototypes%insert('External', external_factory) @@ -471,7 +471,7 @@ function make_factory_from_file(this, file_name, unused, force_file_coordinates, jm = file_metadata%get_dimension('Ydim',rc=status) _VERIFY(status) if (jm == 6*im) then - allocate(factory, source=this%make_clone('Old-Cubed-Sphere')) + allocate(factory, source=this%make_clone('Cubed-Sphere')) else nf = file_metadata%get_dimension('nf',rc=status) if (status == _SUCCESS) then @@ -494,7 +494,7 @@ function make_factory_from_file(this, file_name, unused, force_file_coordinates, end if if (jm == 6*im) then ! old-format cubed-sphere - allocate(factory, source=this%make_clone('Old-Cubed-Sphere')) + allocate(factory, source=this%make_clone('Cubed-Sphere')) !!$ elseif (...) then ! something that is true for tripolar? !!$ factory = this%make_clone('tripolar') else diff --git a/base/MAPL_IO.F90 b/base/MAPL_IO.F90 index 313454918ff9..6f5fd0a869f4 100644 --- a/base/MAPL_IO.F90 +++ b/base/MAPL_IO.F90 @@ -7881,10 +7881,31 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) type (StringIntegerMap), save :: RstCollections type (StringIntegerMapIterator) :: iter type (StringVariableMap) :: var_map + logical :: have_target_lon, have_target_lat, have_stretch_factor + real :: target_lon, target_lat, stretch_factor + logical :: is_stretched call ESMF_FieldBundleGet(Bundle,FieldCount=nVars, name=BundleName, rc=STATUS) _VERIFY(STATUS) + call ESMF_AttributeGet(arrdes%grid,name="TARGET_LON",isPresent=have_target_lon,rc=status) + _VERIFY(status) + call ESMF_AttributeGet(arrdes%grid,name="TARGET_LAT",isPresent=have_target_lat,rc=status) + _VERIFY(status) + call ESMF_AttributeGet(arrdes%grid,name="STRETCH_FACTOR",isPresent=have_stretch_factor,rc=status) + _VERIFY(status) + if (have_target_lon .and. have_target_lat .and. have_stretch_factor) then + is_stretched = .true. + call ESMF_AttributeGet(arrdes%grid,name="TARGET_LON",value=target_lon,rc=status) + _VERIFY(status) + call ESMF_AttributeGet(arrdes%grid,name="TARGET_LAT",value=target_lat,rc=status) + _VERIFY(status) + call ESMF_AttributeGet(arrdes%grid,name="STRETCH_FACTOR",value=stretch_factor,rc=status) + _VERIFY(status) + else + is_stretched = .false. + end if + ! verify that file is compatible with fields in bundle we are reading @@ -8065,6 +8086,11 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) isCubed = .true. x0=1.0d0 x1=dble(arrdes%IM_WORLD) + if (is_stretched) then + call cf%add_attribute('TARGET_LON',target_lon) + call cf%add_attribute('TARGET_LAT',target_lat) + call cf%add_attribute('STRETCH_FACTOR',stretch_factor) + end if else isCubed = .false. x0=-180.0d0 @@ -8574,6 +8600,7 @@ subroutine MAPL_StateVarWriteNCPar(filename, STATE, ARRDES, CLOCK, NAME, forceWr call ESMF_FieldBundleSet(bundle_write,grid=arrdes%grid,rc=STATUS) _VERIFY(STATUS) + DO I = 1, ITEMCOUNT diff --git a/base/MAPL_LatLonGridFactory.F90 b/base/MAPL_LatLonGridFactory.F90 index 70fe9eeb9dbd..7b6b901a35d2 100644 --- a/base/MAPL_LatLonGridFactory.F90 +++ b/base/MAPL_LatLonGridFactory.F90 @@ -96,6 +96,8 @@ module MAPL_LatLonGridFactoryMod procedure :: generate_file_corner_bounds procedure :: generate_file_reference2D procedure :: generate_file_reference3D + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type LatLonGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_LatLonGridFactory::' @@ -1387,60 +1389,98 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, end subroutine initialize_from_esmf_distGrid + function decomps_are_equal(this,a) result(equal) + class (LatLonGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal - - logical function equals(a, b) - class (LatLonGridFactory), intent(in) :: a - class (AbstractGridFactory), intent(in) :: b - - select type (b) + select type (a) class default - equals = .false. + equal = .false. return class is (LatLonGridFactory) - equals = .true. + equal = .true. - equals = (a%im_world == b%im_world) .and. (a%jm_world == b%jm_world) - if (.not. equals) return - - equals = (a%lm == b%lm) - if (.not. equals) return - equals = size(a%ims)==size(b%ims) .and. size(a%jms)==size(b%jms) - if (.not. equals) return + equal = size(a%ims)==size(this%ims) .and. size(a%jms)==size(this%jms) + if (.not. equal) return ! same decomposition - equals = all(a%ims == b%ims) .and. all(a%jms == b%jms) - if (.not. equals) return + equal = all(a%ims == this%ims) .and. all(a%jms == this%jms) + if (.not. equal) return - equals = (a%is_regular .eqv. b%is_regular) - if (.not. equals) return + end select + + end function decomps_are_equal + + + function physical_params_are_equal(this, a) result(equal) + class (LatLonGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal + + select type (a) + class default + equal = .false. + return + class is (LatLonGridFactory) + equal = .true. + + equal = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. equal) return + + equal = (a%is_regular .eqv. this%is_regular) + if (.not. equal) return if (a%is_regular) then - equals = (a%pole == b%pole) - if (.not. equals) return + equal = (a%pole == this%pole) + if (.not. equal) return - equals = (a%dateline == b%dateline) - if (.not. equals) return + equal = (a%dateline == this%dateline) + if (.not. equal) return if (a%pole == 'XY') then - equals = (a%lat_range == b%lat_range) - if (.not. equals) return + equal = (a%lat_range == this%lat_range) + if (.not. equal) return end if if (a%dateline == 'XY') then - equals = (a%lon_range == b%lon_range) - if (.not. equals) return + equal = (a%lon_range == this%lon_range) + if (.not. equal) return end if else - equals = & - & all(a%lon_centers == b%lon_centers) .and. & - & all(a%lon_corners == b%lon_corners) .and. & - & all(a%lat_centers == b%lat_centers) .and. & - & all(a%lat_corners == b%lat_corners) + equal = & + & all(a%lon_centers == this%lon_centers) .and. & + & all(a%lon_corners == this%lon_corners) .and. & + & all(a%lat_centers == this%lat_centers) .and. & + & all(a%lat_corners == this%lat_corners) end if end select + end function physical_params_are_equal + + logical function equals(a, b) + class (LatLonGridFactory), intent(in) :: a + class (AbstractGridFactory), intent(in) :: b + + select type (b) + class default + equals = .false. + return + class is (LatLonGridFactory) + equals = .true. + + equals = (a%lm == b%lm) + if (.not. equals) return + + 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 @@ -1768,13 +1808,14 @@ subroutine append_variable_metadata(this,var) _UNUSED_DUMMY(var) end subroutine append_variable_metadata - subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,metadata,rc) use MAPL_BaseMod class(LatLonGridFactory), intent(inout) :: this type(ESMF_Grid), intent(inout) :: grid integer, allocatable, intent(out) :: local_start(:) integer, allocatable, intent(out) :: global_start(:) integer, allocatable, intent(out) :: global_count(:) + type(FileMetaData), intent(in), optional :: metaData integer, optional, intent(out) :: rc integer :: status @@ -1821,11 +1862,12 @@ function generate_file_reference2D(this,fpointer) result(ref) ref = ArrayReference(fpointer) end function generate_file_reference2D - function generate_file_reference3D(this,fpointer) result(ref) + function generate_file_reference3D(this,fpointer,metaData) result(ref) use pFIO type(ArrayReference) :: ref class(LatLonGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:,:) + type(FileMetaData), intent(in), optional :: metaData _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference3D diff --git a/base/MAPL_LlcGridFactory.F90 b/base/MAPL_LlcGridFactory.F90 index 301713436def..e20ae3a54f85 100644 --- a/base/MAPL_LlcGridFactory.F90 +++ b/base/MAPL_LlcGridFactory.F90 @@ -73,6 +73,8 @@ module MAPL_LlcGridFactoryMod procedure :: generate_file_corner_bounds procedure :: generate_file_reference2D procedure :: generate_file_reference3D + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type LlcGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_LlcGridFactory::' @@ -507,6 +509,48 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, _FAIL('unsupported') end subroutine initialize_from_esmf_distGrid + function decomps_are_equal(this,a) result(equal) + class (LlcGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal + + select type (a) + class default + equal = .false. + return + class is (LlcGridFactory) + equal = .true. + + ! same decomposition + equal = a%nx == this%nx .and. a%ny == this%ny + if (.not. equal) return + + end select + + end function decomps_are_equal + + + function physical_params_are_equal(this, a) result(equal) + class (LlcGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal + + select type (a) + class default + equal = .false. + return + class is (LlcGridFactory) + equal = .true. + + equal = (a%grid_file_name == this%grid_file_name) + if (.not. equal) return + + equal = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. equal) return + + end select + + end function physical_params_are_equal logical function equals(a, b) @@ -520,18 +564,14 @@ logical function equals(a, b) class is (LlcGridFactory) equals = .true. - equals = (a%grid_file_name == b%grid_file_name) - if (.not. equals) return - - equals = (a%im_world == b%im_world) .and. (a%jm_world == b%jm_world) - if (.not. equals) return - equals = (a%lm == b%lm) if (.not. equals) return - ! same decomposition - equals = a%nx == b%nx .and. a%ny == b%ny + equals = a%decomps_are_equal(b) if (.not. equals) return + + equals = a%physical_params_are_equal(b) + if (.not. equals) return end select @@ -928,13 +968,14 @@ subroutine append_variable_metadata(this,var) _UNUSED_DUMMY(var) end subroutine append_variable_metadata - subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,metadata,rc) use MAPL_BaseMod class(LlcGridFactory), intent(inout) :: this type(ESMF_Grid), intent(inout) :: grid integer, allocatable, intent(out) :: local_start(:) integer, allocatable, intent(out) :: global_start(:) integer, allocatable, intent(out) :: global_count(:) + type(FileMetaData), intent(in), optional :: metaData integer, optional, intent(out) :: rc integer :: status @@ -981,10 +1022,11 @@ function generate_file_reference2D(this,fpointer) result(ref) ref = ArrayReference(fpointer) end function generate_file_reference2D - function generate_file_reference3D(this,fpointer) result(ref) + function generate_file_reference3D(this,fpointer,metadata) result(ref) use pFIO type(ArrayReference) :: ref class(LlcGridFactory), intent(inout) :: this + type(FileMetaData), intent(in), optional :: metaData real, pointer, intent(in) :: fpointer(:,:,:) _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) diff --git a/base/MAPL_OldCubedSphereGridFactory.F90 b/base/MAPL_OldCubedSphereGridFactory.F90 deleted file mode 100644 index b84206fd896e..000000000000 --- a/base/MAPL_OldCubedSphereGridFactory.F90 +++ /dev/null @@ -1,966 +0,0 @@ -!----------------------------------------------------- -! Note that this implementation only supports -! "square" faces on the cube. I.e. the number of -! cells along each axis (of each face) are the same. -! IM_WORLD is used for this quantity, and there is no -! equivalent for the "other" axis. -!----------------------------------------------------- - -#include "MAPL_Generic.h" - - -module MAPL_OldCubedSphereGridFactoryMod - use MAPL_AbstractGridFactoryMod - use MAPL_MinMaxMod - use MAPL_KeywordEnforcerMod - use mapl_ErrorHandlingMod - use ESMF - use pFIO - use MAPL_CommsMod - use MAPL_ConstantsMod - use MAPL_IOMod, only : GETFILE, FREE_FILE - use, intrinsic :: iso_fortran_env, only: REAL64,REAL32 - implicit none - private - - public :: OldCubedSphereGridFactory - - integer, parameter :: ndims = 2 - integer, parameter :: UNDEFINED_INTEGER = 1-huge(1) - real, parameter :: UNDEFINED_REAL = huge(1.) - real(REAL64), parameter :: UNDEFINED_REAL64 = huge(1.d0) - character(len=*), parameter :: UNDEFINED_CHAR = '**' - - integer, parameter :: FV_GRID_TYPE_DEFAULT = 0 - character(len=*), parameter :: GRID_NAME_DEFAULT = 'UNKNOWN' - - integer, parameter :: NUM_CUBE_FACES = 6 - - type, extends(AbstractGridFactory) :: OldCubedSphereGridFactory - private - - - character(len=:), allocatable :: grid_name - integer :: grid_type = UNDEFINED_INTEGER - - ! Grid dimensions - Note that we only support "square" grids - integer :: im_world = UNDEFINED_INTEGER - integer :: lm = UNDEFINED_INTEGER - integer :: ntiles = NUM_CUBE_FACES - - ! Domain decomposition: - note that we only support "square" dec - integer :: nx = UNDEFINED_INTEGER - integer :: ny = UNDEFINED_INTEGER - integer, allocatable :: ims(:) - integer, allocatable :: jms(:) - ! rectangle decomposition - integer, allocatable :: jms_2d(:,:) - ! stretching parameters - real :: stretch_factor = UNDEFINED_REAL - real :: target_lon = UNDEFINED_REAL - real :: target_lat = UNDEFINED_REAL - logical :: stretched_cube = .false. - - ! For halo - type(ESMF_RouteHandle) :: rh - - logical :: halo_initialized = .false. - - contains - - procedure :: make_new_grid - procedure :: create_basic_grid - - procedure :: initialize_from_file_metadata - procedure :: initialize_from_config_with_prefix - procedure :: initialize_from_esmf_distGrid - - procedure :: halo_init - procedure :: halo - - procedure :: check_and_fill_consistency - procedure :: equals - procedure :: generate_grid_name - procedure :: to_string - - procedure :: append_metadata - procedure :: get_grid_vars - procedure :: get_file_format_vars - procedure :: append_variable_metadata - procedure :: generate_file_bounds - procedure :: generate_file_corner_bounds - procedure :: generate_file_reference2D - procedure :: generate_file_reference3D - end type OldCubedSphereGridFactory - - character(len=*), parameter :: MOD_NAME = 'OldCubedSphereGridFactory::' - - interface OldCubedSphereGridFactory - module procedure OldCubedSphereGridFactory_from_parameters - end interface OldCubedSphereGridFactory - - interface set_with_default - module procedure set_with_default_integer - module procedure set_with_default_real - module procedure set_with_default_real64 - module procedure set_with_default_character - module procedure set_with_default_bounds - end interface set_with_default - - -contains - - - function OldCubedSphereGridFactory_from_parameters(unusable, grid_name, grid_type, & - & im_world, lm, nx, ny, ims, jms, stretch_factor, target_lon, target_lat, & - & rc) result(factory) - type (OldCubedSphereGridFactory) :: factory - class (KeywordEnforcer), optional, intent(in) :: unusable - character(len=*), optional, intent(in) :: grid_name - integer, optional, intent(in) :: grid_type - - ! grid details: - integer, optional, intent(in) :: im_world - integer, optional, intent(in) :: lm - - ! decomposition: - integer, optional, intent(in) :: nx - integer, optional, intent(in) :: ny - integer, optional, intent(in) :: ims(:) - integer, optional, intent(in) :: jms(:) - - ! stretched grid - real(REAL32), optional, intent(in) :: stretch_factor, target_lon, target_lat - - integer, optional, intent(out) :: rc - - integer :: status - character(len=*), parameter :: Iam = MOD_NAME // 'OldCubedSphereGridFactory_from_parameters' - - if (present(unusable)) print*,shape(unusable) - - call set_with_default(factory%grid_name, grid_name, GRID_NAME_DEFAULT) - call set_with_default(factory%grid_type, grid_type, FV_GRID_TYPE_DEFAULT) - - call set_with_default(factory%nx, nx, UNDEFINED_INTEGER) - call set_with_default(factory%ny, ny, UNDEFINED_INTEGER) - - call set_with_default(factory%im_world, im_world, UNDEFINED_INTEGER) - call set_with_default(factory%lm, lm, UNDEFINED_INTEGER) - - call set_with_default(factory%stretch_factor,stretch_factor,UNDEFINED_REAL) - call set_with_default(factory%target_lon,target_lon,UNDEFINED_REAL) - call set_with_default(factory%target_lat,target_lat,UNDEFINED_REAL) - - ! default is unallocated - if (present(ims)) factory%ims = ims - if (present(jms)) factory%jms = jms - - call factory%check_and_fill_consistency(rc=status) - - _VERIFY(status) - - _RETURN(_SUCCESS) - - end function OldCubedSphereGridFactory_from_parameters - - - function make_new_grid(this, unusable, rc) result(grid) - type (ESMF_Grid) :: grid - class (OldCubedSphereGridFactory), intent(in) :: this - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - integer :: status - character(len=*), parameter :: Iam = MOD_NAME // 'make_grid' - - _UNUSED_DUMMY(unusable) - - grid = this%create_basic_grid(rc=status) - _VERIFY(status) - - _RETURN(_SUCCESS) - - end function make_new_grid - - - - function create_basic_grid(this, unusable, rc) result(grid) - type (ESMF_Grid) :: grid - class (OldCubedSphereGridFactory), intent(in) :: this - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - integer :: i,nTile - integer, allocatable :: ims(:,:), jms(:,:) - real(kind=ESMF_KIND_R8), pointer :: lats(:,:),lons(:,:) - type(ESMF_CubedSphereTransform_Args) :: transformArgument - integer :: status - character(len=*), parameter :: Iam = MOD_NAME // 'create_basic_grid' - - _UNUSED_DUMMY(unusable) - - if (this%grid_type <=3) then - nTile=6 - else - nTile=1 - end if - - allocate(ims(this%nx,nTile)) - do i=1,nTile - ims(:,i)=this%ims - enddo - - if(allocated(this%jms_2d)) then - _ASSERT(size(this%jms_2d,2) == 6,'incompatible shape') - allocate(jms, source = this%jms_2d) - else - allocate(jms(this%ny,nTile)) - do i=1,nTile - jms(:,i)=this%jms - end do - endif - - if (this%grid_type <= 3) then - if (this%stretched_cube) then - transformArgument%stretch_factor=this%stretch_factor - transformArgument%target_lon=this%target_lon - 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, & - transformArgs=transformArgument,rc=status) - _VERIFY(status) - call ESMF_AttributeSet(grid, name='STRETCH_FACTOR', value=this%stretch_factor,rc=status) - _VERIFY(status) - call ESMF_AttributeSet(grid, name='TARGET_LON', value=this%target_lon,rc=status) - _VERIFY(status) - call ESMF_AttributeSet(grid, name='TARGET_LAT', value=this%target_lat,rc=status) - _VERIFY(status) - else - 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, rc=status) - _VERIFY(status) - end if - call ESMF_AttributeSet(grid, name='GridType', value='Cubed-Sphere', rc=status) - else - grid = ESMF_GridCreateNoPeriDim( & - & name = this%grid_name, & - & countsPerDEDim1=this%ims, & - & countsPerDEDim2=this%jms, & - & indexFlag=ESMF_INDEX_DELOCAL, & - & gridEdgeLWidth=[0,0], & - & gridEdgeUWidth=[1,1], & - & coordDep1=[1,2], & - & coordDep2=[1,2], & - & coordSys=ESMF_COORDSYS_SPH_RAD, & - & rc=status) - _VERIFY(status) - call ESMF_AttributeSet(grid, 'GridType', 'Doubly-Periodic', rc=status) - _VERIFY(status) - call ESMF_GridAddCoord(grid,rc=status) - _VERIFY(status) - call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=lons, rc=status) - _VERIFY(status) - lons=0.0 - call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=lats, rc=status) - _VERIFY(status) - lats=0.0 - - end if - - deallocate(ims,jms) - - if (this%lm /= UNDEFINED_INTEGER) then - call ESMF_AttributeSet(grid, name='GRID_LM', value=this%lm, rc=status) - _VERIFY(status) - end if - - call ESMF_AttributeSet(grid, name='NEW_CUBE', value=1,rc=status) - _VERIFY(status) - - _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 - - class (OldCubedSphereGridFactory), intent(inout) :: this - type (FileMetadata), target, intent(in) :: file_metadata - class (KeywordEnforcer), optional, intent(in) :: unusable - logical, optional, intent(in) :: force_file_coordinates - integer, optional, intent(out) :: rc - - character(len=*), parameter :: Iam= MOD_NAME // 'initialize_from_file_metadata()' - integer :: status - logical :: hasLev,hasLevel - character(:), allocatable :: lev_name - - associate(im => this%im_world) - im = file_metadata%get_dimension('Xdim',rc=status) - _VERIFY(status) - end associate - call this%make_arbitrary_decomposition(this%nx, this%ny, reduceFactor=6, rc=status) - _VERIFY(status) - - hasLev=.false. - hasLevel=.false. - lev_name = 'lev' - hasLev = file_metadata%has_dimension(lev_name) - if (hasLev) then - this%lm = file_metadata%get_dimension(lev_name,rc=status) - _VERIFY(status) - else - lev_name = 'levels' - hasLevel = file_metadata%has_dimension(lev_name) - if (hasLevel) then - this%lm = file_metadata%get_dimension(lev_name,rc=status) - _VERIFY(status) - end if - end if - - allocate(this%ims(0:this%nx-1)) - allocate(this%jms(0:this%ny-1)) - call MAPL_DecomposeDim(this%im_world, this%ims, this%nx, min_DE_extent=2) - call MAPL_DecomposeDim(this%im_world, this%jms, this%ny, min_DE_extent=2) - call this%check_and_fill_consistency(rc=status) - _VERIFY(status) - - _UNUSED_DUMMY(unusable) - - end subroutine initialize_from_file_metadata - - - subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc) - use esmf - class (OldCubedSphereGridFactory), intent(inout) :: this - type (ESMF_Config), intent(inout) :: config - character(len=*), intent(in) :: prefix ! effectively optional due to overload without this argument - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - integer :: status - character(len=*), parameter :: Iam = MOD_NAME//'make_geos_grid_from_config' - character(len=ESMF_MAXSTR) :: tmp - type (ESMF_VM) :: vm - integer :: vmcomm, ndes - - if (present(unusable)) print*,shape(unusable) - - call ESMF_VMGetCurrent(vm, rc=status) - _VERIFY(status) - - call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=GRID_NAME_DEFAULT) - this%grid_name = trim(tmp) - - call ESMF_ConfigGetAttribute(config, this%grid_type, label=prefix//'CS_GRID_TYPE:', default=FV_GRID_TYPE_DEFAULT) - - call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=UNDEFINED_INTEGER) - - call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=UNDEFINED_INTEGER) - - call ESMF_ConfigGetAttribute(config, this%stretch_factor, label=prefix//'STRETCH_FACTOR:', default=UNDEFINED_REAL) - call ESMF_ConfigGetAttribute(config, this%target_lon, label=prefix//'TARGET_LON:', default=UNDEFINED_REAL) - call ESMF_ConfigGetAttribute(config, this%target_lat, label=prefix//'TARGET_LAT:', default=UNDEFINED_REAL) - - call get_multi_integer(this%ims, 'IMS:', rc=status) - _VERIFY(status) - - call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'JMS_FILE:', rc=status) - if (status == _SUCCESS) then - call get_jms_from_file(this%jms_2d, trim(tmp),this%ny, rc=status) - _VERIFY(status) - else - call get_multi_integer(this%jms, 'JMS:', rc=status) - _VERIFY(status) - endif - - call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=UNDEFINED_INTEGER) - - call this%check_and_fill_consistency(rc=status) - _VERIFY(status) - - ! halo initialization - - call ESMF_VmGet(VM, mpicommunicator=vmcomm, petCount=ndes, rc=status) - _VERIFY(status) - - - _RETURN(_SUCCESS) - - contains - - subroutine get_multi_integer(values, label, rc) - integer, allocatable, intent(out) :: values(:) - character(len=*) :: label - integer, optional, intent(out) :: rc - - integer :: i - integer :: n - integer :: tmp - integer :: status - logical :: isPresent - - call ESMF_ConfigFindLabel(config, label=prefix//label,isPresent=isPresent,rc=status) - _VERIFY(status) - if (.not. isPresent) then - _RETURN(_SUCCESS) - end if - - ! First pass: count values - n = 0 - do - call ESMF_ConfigGetAttribute(config, tmp, default=UNDEFINED_INTEGER, rc=status) - if (status /= _SUCCESS) then - exit - else - n = n + 1 - end if - end do - - ! Second pass: allocate and fill - allocate(values(n), stat=status) ! no point in checking status - _VERIFY(status) - call ESMF_ConfigFindLabel(config, label=prefix//label,isPresent=isPresent,rc=status) - _VERIFY(status) - do i = 1, n - call ESMF_ConfigGetAttribute(config, values(i), rc=status) - _VERIFY(status) - end do - - _RETURN(_SUCCESS) - - end subroutine get_multi_integer - - subroutine get_jms_from_file(values, file_name, n, rc) - integer, allocatable, intent(out) :: values(:,:) - character(len=*), intent(in) :: file_name - integer, intent(in) :: n - integer, optional, intent(out) :: rc - - logical :: FileExists - integer :: i,k,face,total, unit, max_procs - 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) - - inquire(FILE = trim(file_name), EXIST=FileExists) - if ( .not. FileExists) then - print*, file_name // " does not exist" - _RETURN(_FAILURE) - - elseif (MAPL_AM_I_Root(VM)) then - - UNIT = GETFILE ( trim(file_name), form="formatted", rc=status ) - _VERIFY(STATUS) - read(UNIT,*) total, max_procs - if (total /= N_proc) then - print*, "n /= total" - _RETURN(_FAILURE) - endif - do i = 1,total - read(UNIT,*) values_tmp(i) - enddo - call FREE_FILE(UNIT) - endif - - call MAPL_CommsBcast(VM, max_procs, n=1, ROOT=MAPL_Root, rc=status) - call MAPL_CommsBcast(VM, values_tmp, n=N_proc, ROOT=MAPL_Root, rc=status) - _VERIFY(STATUS) - - ! distributed to 6 faces - allocate(values_(max_procs,6)) - values_ = 0 - k = 1 - do NF = 1, 6 - face = 0 - do i = 1, max_procs - values_(i,NF) = values_tmp(k) - face = face + values_tmp(k) - k = k+1 - if (face == this%im_world) exit - enddo - enddo - values = values_ - - _RETURN(_SUCCESS) - - end subroutine get_jms_from_file - - subroutine get_bounds(bounds, label, rc) - type(RealMinMax), intent(out) :: bounds - character(len=*) :: label - integer, optional, intent(out) :: rc - - integer :: i - integer :: n - integer :: status - logical :: isPresent - - call ESMF_ConfigFindLabel(config, label=prefix//label,isPresent=isPresent,rc=status) - _VERIFY(status) - if (.not. isPresent) then - _RETURN(_SUCCESS) - end if - - ! Must be 2 values: min and max - call ESMF_ConfigGetAttribute(config, bounds%min, rc=status) - _VERIFY(status) - call ESMF_ConfigGetAttribute(config, bounds%max, rc=status) - _VERIFY(status) - - _RETURN(_SUCCESS) - - end subroutine get_bounds - - - end subroutine initialize_from_config_with_prefix - - subroutine halo_init(this, halo_width,rc) - class (OldCubedSphereGridFactory), intent(inout) :: this - integer, optional, intent(in) :: halo_width - integer, optional, intent(out) :: rc - - type(ESMF_Field) :: field - type(ESMF_Grid), pointer :: grid - integer :: useableHalo_width,status - real, pointer :: ptr(:,:) - character(len=*), parameter :: Iam = MOD_NAME // 'halo_init' - - if (present(halo_width)) then - useableHalo_width=halo_width - else - useableHalo_width=1 - end if - - grid => this%get_grid(rc=status) - _VERIFY(status) - field = ESMF_FieldCreate(grid,ESMF_TYPEKIND_R4, & - totalLWidth=[useableHalo_width,useableHalo_width], & - totalUWidth=[useableHalo_width,useableHalo_width], & - rc=status) - _VERIFY(status) - call ESMF_FieldGet(field,farrayPtr=ptr,rc=status) - _VERIFY(status) - ptr=0.0 - call ESMF_FieldHaloStore(field,this%rh,rc=status) - _VERIFY(status) - call ESMF_FieldDestroy(field,rc=status) - _VERIFY(status) - - end subroutine halo_init - - function to_string(this) result(string) - character(len=:), allocatable :: string - class (OldCubedSphereGridFactory), intent(in) :: this - - _UNUSED_DUMMY(this) - string = 'OldCubedSphereGridFactory' - - end function to_string - - subroutine check_and_fill_consistency(this, unusable, rc) - use MAPL_BaseMod, only: MAPL_DecomposeDim - use MAPL_ConstantsMod, only: PI => MAPL_PI_R8 - class (OldCubedSphereGridFactory), intent(inout) :: this - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - integer :: status - character(len=*), parameter :: Iam = MOD_NAME // 'check_and_fill_consistency' - - _UNUSED_DUMMY(unusable) - - if (.not. allocated(this%grid_name)) then - this%grid_name = GRID_NAME_DEFAULT - end if - - if (this%grid_type == UNDEFINED_INTEGER) then - this%grid_type = FV_GRID_TYPE_DEFAULT ! fv default - end if - - if ( (this%target_lon /= UNDEFINED_REAL) .and. & - (this%target_lat /= UNDEFINED_REAL) .and. & - (this%stretch_factor /= UNDEFINED_REAL) ) then - _ASSERT( (this%target_lat >= -90.0) .and. (this%target_lat <= 90), 'latitude out of range') - this%stretched_cube = .true. - this%target_lon=this%target_lon*pi/180.d0 - this%target_lat=this%target_lat*pi/180.d0 - end if - - ! Check decomposition/bounds - ! WY notes: not necessary for this assert - !_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(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) - integer, intent(inout) :: n - integer, intent(inout) :: m_world - integer, allocatable, intent(inout) :: ms(:) - integer, optional, intent(out) :: rc - - integer :: status - - if (allocated(ms)) then - _ASSERT(size(ms) > 0, 'must be > 0 PEs in each dimension') - - if (n == UNDEFINED_INTEGER) then - n = size(ms) - else - _ASSERT(n == size(ms), 'inconsistent specs') - end if - - if (m_world == UNDEFINED_INTEGER) then - m_world = sum(ms) - else - _ASSERT(m_world == sum(ms), 'inconsistent specs') - end if - - else - - _ASSERT(n /= UNDEFINED_INTEGER,'n not specified') - _ASSERT(m_world /= UNDEFINED_INTEGER,'m_wold not specified') - allocate(ms(n), stat=status) - _VERIFY(status) - - call MAPL_DecomposeDim (m_world, ms, n, symmetric=.true.) - - end if - - _RETURN(_SUCCESS) - - end subroutine verify - - end subroutine check_and_fill_consistency - - - 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 - - - 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 - - - logical function equals(a, b) - class (OldCubedSphereGridFactory), intent(in) :: a - class (AbstractGridFactory), intent(in) :: b - - select type (b) - class default - equals = .false. - return - class is (OldCubedSphereGridFactory) - equals = .true. - - equals = (a%im_world == b%im_world) - if (.not. equals) return - - equals = (a%lm == b%lm) - if (.not. equals) return - - ! same decomposition - equals = all(a%ims == b%ims) - if (.not. equals) return - - if ( allocated(a%jms) .and. allocated(b%jms)) then - equals = all(a%jms == b%jms) - if (.not. equals) return - else - equals = all(a%jms_2d == b%jms_2d) - if (.not. equals) return - endif - - end select - - end function equals - - subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, unusable, rc) - class (OldCubedSphereGridFactory), intent(inout) :: this - type (ESMF_DistGrid), intent(in) :: dist_grid - type (ESMF_LocalArray), intent(in) :: lon_array - type (ESMF_LocalArray), intent(in) :: lat_array - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - character(len=*), parameter :: Iam = MOD_NAME // 'OldCubedSphereGridFactory_initialize_from_esmf_distGrid' - - _UNUSED_DUMMY(this) - _UNUSED_DUMMY(dist_grid) - _UNUSED_DUMMY(lon_array) - _UNUSED_DUMMY(lat_array) - _UNUSED_DUMMY(unusable) - - _FAIL('not implemented') - - end subroutine initialize_from_esmf_distGrid - - subroutine halo(this, array, unusable, halo_width, rc) - use, intrinsic :: iso_fortran_env, only: REAL32 - class (OldCubedSphereGridFactory), intent(inout) :: this - real(kind=REAL32), intent(inout) :: array(:,:) - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(in) :: halo_width - integer, optional, intent(out) :: rc - - integer :: status - character(len=*), parameter :: Iam = MOD_NAME // 'halo' - type(ESMF_Field) :: field - type(ESMF_Grid), pointer :: grid - real, pointer :: ptr(:,:) - integer :: useableHalo_width - - _UNUSED_DUMMY(unusable) - - if (.not. this%halo_initialized) then - call this%halo_init(halo_width = halo_width) - this%halo_initialized = .true. - end if - - if (present(halo_width)) then - useableHalo_width=halo_width - else - useableHalo_width=1 - end if - grid => this%get_grid() - field = ESMF_FieldCreate(grid,ESMF_TYPEKIND_R4, & - totalLWidth=[useableHalo_width,useableHalo_width], & - totalUWidth=[useableHalo_width,useableHalo_width], & - rc=status) - _VERIFY(status) - call ESMF_FieldGet(field,farrayPtr=ptr,rc=status) - _VERIFY(status) - ptr = array - call ESMF_FieldHalo(field,this%rh,rc=status) - _VERIFY(status) - call ESMF_FieldDestroy(field,rc=status) - _VERIFY(status) - - _RETURN(_SUCCESS) - - end subroutine halo - - function generate_grid_name(this) result(name) - class (OldCubedSphereGridFactory), intent(in) :: this - character(len=:), allocatable :: name - - character(len=4) :: im_string - - write(im_string,'(i4.4)') this%im_world - - name = 'CF' // im_string //'x6C' - - end function generate_grid_name - - subroutine append_metadata(this, metadata)!, unusable, rc) - class (OldCubedSphereGridFactory), intent(inout) :: this - type (FileMetadata), intent(inout) :: metadata - - type (Variable) :: v - integer, allocatable :: fake_coords(:) - integer :: i - - ! Horizontal grid dimensions - call metadata%add_dimension('Xdim', this%im_world) - call metadata%add_dimension('Ydim', this%im_world*6) - - ! Coordinate variables - - allocate(fake_coords(this%im_world)) - do i=1,this%im_world - fake_coords(i)=i - enddo - v = Variable(type=PFIO_REAL32, dimensions='Xdim') - call v%add_attribute('long_name', 'Fake Longitude for GrADS Compatibility') - call v%add_attribute('units', 'degrees_east') - call v%add_const_value(UnlimitedEntity(fake_coords)) - call metadata%add_variable('lon', v) - deallocate(fake_coords) - - allocate(fake_coords(this%im_world*6)) - do i=1,this%im_world*6 - fake_coords(i)=i - enddo - v = Variable(type=PFIO_REAL32, dimensions='Ydim') - call v%add_attribute('long_name', 'Fake Latitude for GrADS Compatibility') - call v%add_attribute('units', 'degrees_north') - call v%add_const_value(UnlimitedEntity(fake_coords)) - call metadata%add_variable('lat', v) - deallocate(fake_coords) - - end subroutine append_metadata - - function get_grid_vars(this) result(vars) - class (OldCubedSphereGridFactory), intent(inout) :: this - - character(len=:), allocatable :: vars - _UNUSED_DUMMY(this) - - vars = 'Xdim,Ydim' - - end function get_grid_vars - - function get_file_format_vars(this) result(vars) - class (OldCubedSphereGridFactory), intent(inout) :: this - - character(len=:), allocatable :: vars - _UNUSED_DUMMY(this) - - vars = 'Xdim,Ydim' - - end function get_file_format_vars - - subroutine append_variable_metadata(this,var) - class (OldCubedSphereGridFactory), intent(inout) :: this - type(Variable), intent(inout) :: var - _UNUSED_DUMMY(this) - _UNUSED_DUMMY(var) - end subroutine append_variable_metadata - - subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) - use MAPL_BaseMod - class(OldCubedSphereGridFactory), intent(inout) :: this - type(ESMF_Grid), intent(inout) :: grid - integer, allocatable, intent(out) :: local_start(:) - integer, allocatable, intent(out) :: global_start(:) - integer, allocatable, intent(out) :: global_count(:) - integer, optional, intent(out) :: rc - - integer :: status - integer :: global_dim(3),i1,j1,in,jn - character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' - _UNUSED_DUMMY(this) - - call MAPL_GridGet(grid,globalCellCountPerDim=global_dim,rc=status) - _VERIFY(status) - call MAPL_GridGetInterior(grid,i1,in,j1,jn) - allocate(local_start,source=[i1,j1]) - allocate(global_start,source=[1,1]) - allocate(global_count,source=[global_dim(1),global_dim(2)]) - - _RETURN(_SUCCESS) - - end subroutine generate_file_bounds - - subroutine generate_file_corner_bounds(this,grid,local_start,global_start,global_count,rc) - use MAPL_BaseMod - class(OldCubedSphereGridFactory), intent(inout) :: this - type(ESMF_Grid), intent(inout) :: grid - integer, allocatable, intent(out) :: local_start(:) - integer, allocatable, intent(out) :: global_start(:) - integer, allocatable, intent(out) :: global_count(:) - integer, optional, intent(out) :: rc - - character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' - _UNUSED_DUMMY(this) - _UNUSED_DUMMY(grid) - _UNUSED_DUMMY(local_start) - _UNUSED_DUMMY(global_start) - _UNUSED_DUMMY(global_count) - - _FAIL('unimplemented') - - _RETURN(_SUCCESS) - - end subroutine generate_file_corner_bounds - - function generate_file_reference2D(this,fpointer) result(ref) - use pFIO - type(ArrayReference) :: ref - class(OldCubedSphereGridFactory), intent(inout) :: this - real, pointer, intent(in) :: fpointer(:,:) - _UNUSED_DUMMY(this) - ref = ArrayReference(fpointer) - end function generate_file_reference2D - - function generate_file_reference3D(this,fpointer) result(ref) - use pFIO - use, intrinsic :: ISO_C_BINDING - type(ArrayReference) :: ref - class(OldCubedSphereGridFactory), intent(inout) :: this - real, pointer, intent(in) :: fpointer(:,:,:) - _UNUSED_DUMMY(this) - ref = ArrayReference(fpointer) - end function generate_file_reference3D - -end module MAPL_OldCubedSphereGridFactoryMod diff --git a/base/MAPL_TripolarGridFactory.F90 b/base/MAPL_TripolarGridFactory.F90 index bf5fcd9ce4af..783dd40b3b00 100644 --- a/base/MAPL_TripolarGridFactory.F90 +++ b/base/MAPL_TripolarGridFactory.F90 @@ -66,6 +66,8 @@ module MAPL_TripolarGridFactoryMod procedure :: generate_file_corner_bounds procedure :: generate_file_reference2D procedure :: generate_file_reference3D + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type TripolarGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_TripolarGridFactory::' @@ -565,7 +567,49 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, end subroutine initialize_from_esmf_distGrid + function decomps_are_equal(this,a) result(equal) + class (TripolarGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal + + select type (a) + class default + equal = .false. + return + class is (TripolarGridFactory) + equal = .true. + + ! same decomposition + equal = a%nx == this%nx .and. a%ny == this%ny + if (.not. equal) return + + end select + + end function decomps_are_equal + + function physical_params_are_equal(this, a) result(equal) + class (TripolarGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal + + select type (a) + class default + equal = .false. + return + class is (TripolarGridFactory) + equal = .true. + + equal = (a%grid_file_name == this%grid_file_name) + if (.not. equal) return + + equal = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. equal) return + + end select + + end function physical_params_are_equal + logical function equals(a, b) class (TripolarGridFactory), intent(in) :: a @@ -578,17 +622,13 @@ logical function equals(a, b) class is (TripolarGridFactory) equals = .true. - equals = (a%grid_file_name == b%grid_file_name) + equals = (a%lm == b%lm) if (.not. equals) return - equals = (a%im_world == b%im_world) .and. (a%jm_world == b%jm_world) - if (.not. equals) return - - equals = (a%lm == b%lm) + equals = a%decomps_are_equal(b) if (.not. equals) return - - ! same decomposition - equals = a%nx == b%nx .and. a%ny == b%ny + + equals = a%physical_params_are_equal(b) if (.not. equals) return end select @@ -906,13 +946,14 @@ subroutine append_variable_metadata(this,var) _UNUSED_DUMMY(var) end subroutine append_variable_metadata - subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,metadata,rc) use MAPL_BaseMod class(TripolarGridFactory), intent(inout) :: this type(ESMF_Grid), intent(inout) :: grid integer, allocatable, intent(out) :: local_start(:) integer, allocatable, intent(out) :: global_start(:) integer, allocatable, intent(out) :: global_count(:) + type(FileMetaData), intent(in), optional :: metaData integer, optional, intent(out) :: rc integer :: status @@ -958,11 +999,12 @@ function generate_file_reference2D(this,fpointer) result(ref) ref = ArrayReference(fpointer) end function generate_file_reference2D - function generate_file_reference3D(this,fpointer) result(ref) + function generate_file_reference3D(this,fpointer,metadata) result(ref) use pFIO type(ArrayReference) :: ref class(TripolarGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:,:) + type(FileMetaData), intent(in), optional :: metaData _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference3D diff --git a/base/MAPL_newCFIO.F90 b/base/MAPL_newCFIO.F90 index e782a3a14956..b8ff2abc58f7 100644 --- a/base/MAPL_newCFIO.F90 +++ b/base/MAPL_newCFIO.F90 @@ -21,6 +21,7 @@ module MAPL_newCFIOMod use MAPL_ExtDataCollectionMod use MAPL_ExtDataCOllectionManagerMod use gFTL_StringVector + use MAPL_FileMetadataUtilsMod use, intrinsic :: ISO_C_BINDING use, intrinsic :: iso_fortran_env, only: REAL64 implicit none @@ -898,8 +899,10 @@ subroutine request_data_from_file(this,filename,timeindex,rc) type(ESMF_Grid) :: output_grid logical :: hasDE class(AbstractGridFactory), pointer :: factory + type(fileMetadataUtils), pointer :: metadata collection => extdatacollections%at(this%metadata_collection_id) + metadata => collection%find(filename) filegrid = collection%src_grid factory => get_factory(filegrid) hasDE=MAPL_GridHasDE(filegrid,rc=status) @@ -912,7 +915,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) end if call MAPL_GridGet(filegrid,globalCellCountPerdim=dims,rc=status) _VERIFY(status) - call factory%generate_file_bounds(fileGrid,gridLocalStart,gridGlobalStart,gridGlobalCount,rc=status) + call factory%generate_file_bounds(fileGrid,gridLocalStart,gridGlobalStart,gridGlobalCount,metadata=metadata%fileMetadata,rc=status) _VERIFY(status) ! create input bundle call ESMF_FieldBundleGet(this%output_bundle,fieldCount=numVars,rc=status) @@ -956,7 +959,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) allocate(ptr3d(0,0,0),stat=status) _VERIFY(status) end if - ref=factory%generate_file_reference3D(ptr3d) + ref=factory%generate_file_reference3D(ptr3d,metadata=metadata%filemetadata) allocate(localStart,source=[gridLocalStart,1,timeIndex]) allocate(globalStart,source=[gridGlobalStart,1,timeIndex]) allocate(globalCount,source=[gridGlobalCount,lm,1]) diff --git a/base/tests/MockGridFactory.F90 b/base/tests/MockGridFactory.F90 index b161a65a50a0..be624232cc68 100644 --- a/base/tests/MockGridFactory.F90 +++ b/base/tests/MockGridFactory.F90 @@ -28,6 +28,8 @@ module MockGridFactoryMod procedure :: initialize_from_file_metadata procedure :: get_grid_vars + procedure :: decomps_are_equal + procedure :: physical_params_are_equal procedure :: append_metadata procedure :: append_variable_metadata procedure :: generate_file_bounds @@ -88,7 +90,33 @@ function make_new_grid(this, unusable, rc) result(grid) end function make_new_grid + function physical_params_are_equal(this,a) result(equal) + class (MockGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal + + select type (a) + class default + equal = .false. + return + class is (MockGridFactory) + equal = .true. + end select + end function physical_params_are_equal + function decomps_are_equal(this,a) result(equal) + class (MockGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + logical :: equal + + select type (a) + class default + equal = .false. + return + class is (MockGridFactory) + equal = .true. + end select + end function decomps_are_equal logical function equals(a, b) class (MockGridFactory), intent(in) :: a @@ -197,7 +225,7 @@ subroutine append_variable_metadata(this,var) _UNUSED_DUMMY(var) end subroutine append_variable_metadata - subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,metadata,rc) use MAPL_BaseMod use ESMF class(MockGridFactory), intent(inout) :: this @@ -205,6 +233,7 @@ subroutine generate_file_bounds(this,grid,local_start,global_start,global_count, integer, allocatable, intent(out) :: local_start(:) integer, allocatable, intent(out) :: global_start(:) integer, allocatable, intent(out) :: global_count(:) + type(FileMetaData), intent(in), optional :: metaData integer, optional, intent(out) :: rc _UNUSED_DUMMY(this) @@ -244,10 +273,11 @@ function generate_file_reference2D(this,fpointer) result(ref) ref = ArrayReference(fpointer) end function generate_file_reference2D - function generate_file_reference3D(this,fpointer) result(ref) + function generate_file_reference3D(this,fpointer,metadata) result(ref) use pFIO type(ArrayReference) :: ref class(MockGridFactory), intent(inout) :: this + type(FileMetaData), intent(in), optional :: metaData real, pointer, intent(in) :: fpointer(:,:,:) _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 73e89648120a..a8e7ee8c170e 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -1339,7 +1339,7 @@ subroutine print_throughput(rc) LOOP_THROUGHPUT,INST_THROUGHPUT,RUN_THROUGHPUT,HRS_R,MIN_R,SEC_R,& mem_committed_percent,mem_used_percent 1000 format(1x,'AGCM Date: ',i4.4,'/',i2.2,'/',i2.2,2x,'Time: ',i2.2,':',i2.2,':',i2.2, & - 2x,'Throughput(days/day)[Avg Tot Run]: ',f6.1,1x,f6.1,1x,f6.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x, & + 2x,'Throughput(days/day)[Avg Tot Run]: ',f8.1,1x,f8.1,1x,f8.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x, & f5.1,'% : ',f5.1,'% Mem Comm:Used') _RETURN(_SUCCESS)