From 62d490f744106598476c62be75622e7a112e42e8 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Jul 2021 11:10:44 -0400 Subject: [PATCH 01/14] Add CMake Presets File --- .gitignore | 1 + CHANGELOG.md | 5 ++ CMakePresets.json | 114 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 120 insertions(+) create mode 100644 CMakePresets.json 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..bee945a769a4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Removed ### Added + +- Add `CMakePresets.json` file + - Note: requires CMake 3.21.0 to use + - Per CMake advice, add `CMakeUserPresets.json` to `.gitignore` + ### Changed ### Fixed diff --git a/CMakePresets.json b/CMakePresets.json new file mode 100644 index 000000000000..2617512165b9 --- /dev/null +++ b/CMakePresets.json @@ -0,0 +1,114 @@ +{ + "version": 2, + "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 Config", + "description": "Release build using GNU Make generator" + }, + { + "name": "Debug", + "inherits": "base-gnu", + "displayName": "Debug Config", + "description": "Debug build using GNU Make generator" + }, + { + "name": "Aggressive", + "inherits": "base-gnu", + "displayName": "Aggressive Config", + "description": "Aggressive build using GNU Make generator" + }, + { + "name": "Release-Ninja", + "inherits": "base-ninja", + "displayName": "Release Ninja Config", + "description": "Release build using Ninja generator" + }, + { + "name": "Debug-Ninja", + "inherits": "base-ninja", + "displayName": "Debug Ninja Config", + "description": "Debug build using Ninja generator" + }, + { + "name": "Aggressive-Ninja", + "inherits": "base-ninja", + "displayName": "Aggressive Ninja Config", + "description": "Aggressive build using Ninja generator" + } + ], + "buildPresets": [ + { + "name": "base-build", + "hidden": true, + "displayName": "Base Build Config", + "description": "Sets default build options", + "jobs": 4, + "targets": ["install"] + }, + { + "name": "Release", + "configurePreset": "Release", + "inherits": "base-build" + }, + { + "name": "Debug", + "configurePreset": "Debug", + "inherits": "base-build" + }, + { + "name": "Aggressive", + "configurePreset": "Aggressive", + "inherits": "base-build" + }, + { + "name": "Release-Ninja", + "configurePreset": "Release-Ninja", + "inherits": "base-build" + }, + { + "name": "Debug-Ninja", + "configurePreset": "Debug-Ninja", + "inherits": "base-build" + }, + { + "name": "Aggressive-Ninja", + "configurePreset": "Aggressive-Ninja", + "inherits": "base-build" + } + ] +} From 4fa8fdf77c26548ffef856d2089ec6fecb89a785 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Jul 2021 12:29:26 -0400 Subject: [PATCH 02/14] Update defaults --- CMakePresets.json | 49 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 47 insertions(+), 2 deletions(-) diff --git a/CMakePresets.json b/CMakePresets.json index 2617512165b9..d7deee07f680 100644 --- a/CMakePresets.json +++ b/CMakePresets.json @@ -1,5 +1,5 @@ { - "version": 2, + "version": 3, "cmakeMinimumRequired": { "major": 3, "minor": 21, @@ -77,7 +77,7 @@ "hidden": true, "displayName": "Base Build Config", "description": "Sets default build options", - "jobs": 4, + "jobs": 6, "targets": ["install"] }, { @@ -110,5 +110,50 @@ "configurePreset": "Aggressive-Ninja", "inherits": "base-build" } + ], + "testPresets": [ + { + "name": "base-test", + "hidden": true, + "displayName": "Base Test Config", + "description": "Sets default test options", + "output": { + "outputOnFailure": true + }, + "execution": { + "jobs": 6, + "noTestsAction": "error" + } + }, + { + "name": "Release", + "configurePreset": "Release", + "inherits": "base-test" + }, + { + "name": "Debug", + "configurePreset": "Debug", + "inherits": "base-test" + }, + { + "name": "Aggressive", + "configurePreset": "Aggressive", + "inherits": "base-test" + }, + { + "name": "Release-Ninja", + "configurePreset": "Release-Ninja", + "inherits": "base-test" + }, + { + "name": "Debug-Ninja", + "configurePreset": "Debug-Ninja", + "inherits": "base-test" + }, + { + "name": "Aggressive-Ninja", + "configurePreset": "Aggressive-Ninja", + "inherits": "base-test" + } ] } From 4a61f75437bfbd973ee90b61d57f454e7f1305ed Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Jul 2021 12:44:14 -0400 Subject: [PATCH 03/14] Add more descriptions --- CMakePresets.json | 48 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 36 insertions(+), 12 deletions(-) diff --git a/CMakePresets.json b/CMakePresets.json index d7deee07f680..65940343d56f 100644 --- a/CMakePresets.json +++ b/CMakePresets.json @@ -83,32 +83,44 @@ { "name": "Release", "configurePreset": "Release", - "inherits": "base-build" + "inherits": "base-build", + "displayName": "Release Build", + "description": "Release build using GNU Make generator" }, { "name": "Debug", "configurePreset": "Debug", - "inherits": "base-build" + "inherits": "base-build", + "displayName": "Debug Build", + "description": "Debug build using GNU Make generator" }, { "name": "Aggressive", "configurePreset": "Aggressive", - "inherits": "base-build" + "inherits": "base-build", + "displayName": "Aggressive Build", + "description": "Aggressive build using GNU Make generator" }, { "name": "Release-Ninja", "configurePreset": "Release-Ninja", - "inherits": "base-build" + "inherits": "base-build", + "displayName": "Release Ninja Build", + "description": "Release build using Ninja generator" }, { "name": "Debug-Ninja", "configurePreset": "Debug-Ninja", - "inherits": "base-build" + "inherits": "base-build", + "displayName": "Debug Ninja Build", + "description": "Debug build using Ninja generator" }, { "name": "Aggressive-Ninja", "configurePreset": "Aggressive-Ninja", - "inherits": "base-build" + "inherits": "base-build", + "displayName": "Aggressive Ninja Build", + "description": "Aggressive build using Ninja generator" } ], "testPresets": [ @@ -128,32 +140,44 @@ { "name": "Release", "configurePreset": "Release", - "inherits": "base-test" + "inherits": "base-test", + "displayName": "Release Test", + "description": "Release Test using GNU Make generator" }, { "name": "Debug", "configurePreset": "Debug", - "inherits": "base-test" + "inherits": "base-test", + "displayName": "Debug Test", + "description": "Debug Test using GNU Make generator" }, { "name": "Aggressive", "configurePreset": "Aggressive", - "inherits": "base-test" + "inherits": "base-test", + "displayName": "Aggressive Test", + "description": "Aggressive Test using GNU Make generator" }, { "name": "Release-Ninja", "configurePreset": "Release-Ninja", - "inherits": "base-test" + "inherits": "base-test", + "displayName": "Release Ninja Test", + "description": "Release Test using Ninja generator" }, { "name": "Debug-Ninja", "configurePreset": "Debug-Ninja", - "inherits": "base-test" + "inherits": "base-test", + "displayName": "Debug Ninja Test", + "description": "Debug Test using Ninja generator" }, { "name": "Aggressive-Ninja", "configurePreset": "Aggressive-Ninja", - "inherits": "base-test" + "inherits": "base-test", + "displayName": "Aggressive Ninja Test", + "description": "Aggressive Test using Ninja generator" } ] } From 8fe1cfc9429007d82232bd3496a671716312b297 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Jul 2021 12:45:07 -0400 Subject: [PATCH 04/14] Tell GitHub Actions to ignore json files --- .github/workflows/workflow.yml | 1 + 1 file changed, 1 insertion(+) 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" From 04a4913fa95e5e8af41d85e74698f4ccf0081cd9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Jul 2021 13:49:44 -0400 Subject: [PATCH 05/14] Remove tests from presets file --- CMakePresets.json | 57 ----------------------------------------------- 1 file changed, 57 deletions(-) diff --git a/CMakePresets.json b/CMakePresets.json index 65940343d56f..e5e5442cfa96 100644 --- a/CMakePresets.json +++ b/CMakePresets.json @@ -122,62 +122,5 @@ "displayName": "Aggressive Ninja Build", "description": "Aggressive build using Ninja generator" } - ], - "testPresets": [ - { - "name": "base-test", - "hidden": true, - "displayName": "Base Test Config", - "description": "Sets default test options", - "output": { - "outputOnFailure": true - }, - "execution": { - "jobs": 6, - "noTestsAction": "error" - } - }, - { - "name": "Release", - "configurePreset": "Release", - "inherits": "base-test", - "displayName": "Release Test", - "description": "Release Test using GNU Make generator" - }, - { - "name": "Debug", - "configurePreset": "Debug", - "inherits": "base-test", - "displayName": "Debug Test", - "description": "Debug Test using GNU Make generator" - }, - { - "name": "Aggressive", - "configurePreset": "Aggressive", - "inherits": "base-test", - "displayName": "Aggressive Test", - "description": "Aggressive Test using GNU Make generator" - }, - { - "name": "Release-Ninja", - "configurePreset": "Release-Ninja", - "inherits": "base-test", - "displayName": "Release Ninja Test", - "description": "Release Test using Ninja generator" - }, - { - "name": "Debug-Ninja", - "configurePreset": "Debug-Ninja", - "inherits": "base-test", - "displayName": "Debug Ninja Test", - "description": "Debug Test using Ninja generator" - }, - { - "name": "Aggressive-Ninja", - "configurePreset": "Aggressive-Ninja", - "inherits": "base-test", - "displayName": "Aggressive Ninja Test", - "description": "Aggressive Test using Ninja generator" - } ] } From b7544290fdcfbd7f4165f22036b78ca6dd50fea2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Jul 2021 14:40:15 -0400 Subject: [PATCH 06/14] Trivial commit to trigger CI --- CMakePresets.json | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/CMakePresets.json b/CMakePresets.json index e5e5442cfa96..b616a275677f 100644 --- a/CMakePresets.json +++ b/CMakePresets.json @@ -37,37 +37,37 @@ { "name": "Release", "inherits": "base-gnu", - "displayName": "Release Config", + "displayName": "Release Configure", "description": "Release build using GNU Make generator" }, { "name": "Debug", "inherits": "base-gnu", - "displayName": "Debug Config", + "displayName": "Debug Configure", "description": "Debug build using GNU Make generator" }, { "name": "Aggressive", "inherits": "base-gnu", - "displayName": "Aggressive Config", + "displayName": "Aggressive Configure", "description": "Aggressive build using GNU Make generator" }, { "name": "Release-Ninja", "inherits": "base-ninja", - "displayName": "Release Ninja Config", + "displayName": "Release Ninja Configure", "description": "Release build using Ninja generator" }, { "name": "Debug-Ninja", "inherits": "base-ninja", - "displayName": "Debug Ninja Config", + "displayName": "Debug Ninja Configure", "description": "Debug build using Ninja generator" }, { "name": "Aggressive-Ninja", "inherits": "base-ninja", - "displayName": "Aggressive Ninja Config", + "displayName": "Aggressive Ninja Configure", "description": "Aggressive build using Ninja generator" } ], From b63512842b823a38197df322994414c1d69bc5e8 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 22 Jul 2021 15:18:36 -0400 Subject: [PATCH 07/14] adding stretch parameters --- base/CMakeLists.txt | 2 +- base/MAPL_AbstractGridFactory.F90 | 22 ++- base/MAPL_CubedSphereGridFactory.F90 | 197 ++++++++++++++++++++++----- base/MAPL_ExternalGridFactory.F90 | 36 ++++- base/MAPL_Generic.F90 | 9 +- base/MAPL_GridManager.F90 | 10 +- base/MAPL_IO.F90 | 27 ++++ base/MAPL_LatLonGridFactory.F90 | 108 ++++++++++----- base/MAPL_LlcGridFactory.F90 | 60 ++++++-- base/MAPL_TripolarGridFactory.F90 | 60 ++++++-- 10 files changed, 433 insertions(+), 98 deletions(-) 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..17bf2fd2c1ae 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(test_decomp_equals), deferred :: test_decomp_equals + procedure(test_physical_params_equals), deferred :: test_physical_params_equals end type AbstractGridFactory abstract interface @@ -89,6 +91,18 @@ logical function equals(a, b) class (AbstractGridFactory), intent(in) :: b end function equals + logical function test_decomp_equals(this,a) + import AbstractGridFactory + class (AbstractGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + end function test_decomp_equals + + logical function test_physical_params_equals(this,a) + import AbstractGridFactory + class (AbstractGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + end function test_physical_params_equals + 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..2e126b453e22 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 :: test_decomp_equals + procedure :: test_physical_params_equals 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,65 @@ elemental subroutine set_with_default_bounds(to, from, default) end subroutine set_with_default_bounds + logical function test_decomp_equals(this, a) + class (CubedSphereGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + integer :: a_nx,b_nx,a_ny,b_ny + + select type(a) + class default + test_decomp_equals = .false. + class is (CubedSphereGridFactory) + test_decomp_equals = .true. + test_decomp_equals = all(a%ims == this%ims) + if (.not. test_decomp_equals) 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) + test_decomp_equals = a_nx*a_ny == b_nx*b_ny + if (.not. test_decomp_equals) return + else + test_decomp_equals = all(a%jms_2d == this%jms_2d) + if (.not. test_decomp_equals) return + endif + end select + + end function test_decomp_equals + + logical function test_physical_params_equals(this, a) + class (CubedSphereGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + + select type (a) + class default + test_physical_params_equals = .false. + return + class is (CubedSphereGridFactory) + test_physical_params_equals = .true. + + test_physical_params_equals = (a%im_world == this%im_world) + if (.not. test_physical_params_equals) return + + test_physical_params_equals = (a%stretch_factor == this%stretch_factor) + if (.not. test_physical_params_equals) return + + test_physical_params_equals = (a%target_lon == this%target_lon) + if (.not. test_physical_params_equals) return + + test_physical_params_equals = (a%target_lat == this%target_lat) + if (.not. test_physical_params_equals) return + + end select + + end function test_physical_params_equals 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 +838,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%test_decomp_equals(b) + if (.not. equals) return - ! same decomposition - equals = all(a%ims == b%ims) + equals = a%test_physical_params_equals(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 +1247,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 +1304,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 +1333,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..19d584c95361 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 :: test_decomp_equals + procedure :: test_physical_params_equals end type ExternalGridFactory interface ExternalGridFactory @@ -105,6 +107,34 @@ function make_new_grid(this, unusable, rc) result(grid) _RETURN(_SUCCESS) end function make_new_grid + logical function test_decomp_equals(this,a) + class(ExternalGridFactory), intent(in) :: this + class(AbstractGridFactory), intent(in) :: a + + _UNUSED_DUMMY(this) + select type(a) + class default + test_decomp_equals = .false. + return + class is (ExternalGridFactory) + test_decomp_equals = .true. + end select + end function test_decomp_equals + + logical function test_physical_params_equals(this,a) + class(ExternalGridFactory), intent(in) :: this + class(AbstractGridFactory), intent(in) :: a + + _UNUSED_DUMMY(this) + select type(a) + class default + test_physical_params_equals = .false. + return + class is (ExternalGridFactory) + test_physical_params_equals = .true. + end select + end function test_physical_params_equals + logical function equals(a, b) class(ExternalGridFactory), intent(in) :: a class(AbstractGridFactory), intent(in) :: b @@ -238,12 +268,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 +318,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..34695e927a12 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,9 @@ 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 _UNUSED_DUMMY(CLOCK) @@ -5893,6 +5898,9 @@ 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 + app_factory => get_factory(MPL%GRID%ESMFGRID) + allocate(file_factory,source=grid_manager%make_factory(trim(filename))) + _ASSERT(file_factory%test_physical_params_equals(app_factory),"Factories not equal") call ArrDescrSetNCPar(arrdes,MPL,num_readers=mpl%grid%num_readers,RC=STATUS) _VERIFY(STATUS) end if PNC4_TILE @@ -9921,7 +9929,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..08627783d387 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 :: test_decomp_equals + procedure :: test_physical_params_equals end type LatLonGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_LatLonGridFactory::' @@ -1387,60 +1389,96 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, end subroutine initialize_from_esmf_distGrid + logical function test_decomp_equals(this,a) + class (LatLonGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a - - 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. + test_decomp_equals = .false. return class is (LatLonGridFactory) - equals = .true. + test_decomp_equals = .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 + test_decomp_equals = size(a%ims)==size(this%ims) .and. size(a%jms)==size(this%jms) + if (.not. test_decomp_equals) return ! same decomposition - equals = all(a%ims == b%ims) .and. all(a%jms == b%jms) - if (.not. equals) return + test_decomp_equals = all(a%ims == this%ims) .and. all(a%jms == this%jms) + if (.not. test_decomp_equals) return - equals = (a%is_regular .eqv. b%is_regular) - if (.not. equals) return + end select + + end function test_decomp_equals + + + logical function test_physical_params_equals(this, a) + class (LatLonGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + + select type (a) + class default + test_physical_params_equals = .false. + return + class is (LatLonGridFactory) + test_physical_params_equals = .true. + + test_physical_params_equals = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. test_physical_params_equals) return + + test_physical_params_equals = (a%is_regular .eqv. this%is_regular) + if (.not. test_physical_params_equals) return if (a%is_regular) then - equals = (a%pole == b%pole) - if (.not. equals) return + test_physical_params_equals = (a%pole == this%pole) + if (.not. test_physical_params_equals) return - equals = (a%dateline == b%dateline) - if (.not. equals) return + test_physical_params_equals = (a%dateline == this%dateline) + if (.not. test_physical_params_equals) return if (a%pole == 'XY') then - equals = (a%lat_range == b%lat_range) - if (.not. equals) return + test_physical_params_equals = (a%lat_range == this%lat_range) + if (.not. test_physical_params_equals) return end if if (a%dateline == 'XY') then - equals = (a%lon_range == b%lon_range) - if (.not. equals) return + test_physical_params_equals = (a%lon_range == this%lon_range) + if (.not. test_physical_params_equals) 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) + test_physical_params_equals = & + & 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 test_physical_params_equals + + 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%test_decomp_equals(b) + if (.not. equals) return + + equals = a%test_physical_params_equals(b) + if (.not. equals) return + + end select + end function equals @@ -1768,13 +1806,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 +1860,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..0bf1f5d0b17e 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 :: test_decomp_equals + procedure :: test_physical_params_equals end type LlcGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_LlcGridFactory::' @@ -507,6 +509,46 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, _FAIL('unsupported') end subroutine initialize_from_esmf_distGrid + logical function test_decomp_equals(this,a) + class (LlcGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + + select type (a) + class default + test_decomp_equals = .false. + return + class is (LlcGridFactory) + test_decomp_equals = .true. + + ! same decomposition + test_decomp_equals = a%nx == this%nx .and. a%ny == this%ny + if (.not. test_decomp_equals) return + + end select + + end function test_decomp_equals + + + logical function test_physical_params_equals(this, a) + class (LlcGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + + select type (a) + class default + test_physical_params_equals = .false. + return + class is (LlcGridFactory) + test_physical_params_equals = .true. + + test_physical_params_equals = (a%grid_file_name == this%grid_file_name) + if (.not. test_physical_params_equals) return + + test_physical_params_equals = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. test_physical_params_equals) return + + end select + + end function test_physical_params_equals logical function equals(a, b) @@ -520,18 +562,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%test_decomp_equals(b) if (.not. equals) return + + equals = a%test_physical_params_equals(b) + if (.not. equals) return end select @@ -928,13 +966,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 +1020,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_TripolarGridFactory.F90 b/base/MAPL_TripolarGridFactory.F90 index bf5fcd9ce4af..9e96dba90653 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 :: test_decomp_equals + procedure :: test_physical_params_equals end type TripolarGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_TripolarGridFactory::' @@ -565,7 +567,47 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, end subroutine initialize_from_esmf_distGrid + logical function test_decomp_equals(this,a) + class (TripolarGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + + select type (a) + class default + test_decomp_equals = .false. + return + class is (TripolarGridFactory) + test_decomp_equals = .true. + + ! same decomposition + test_decomp_equals = a%nx == this%nx .and. a%ny == this%ny + if (.not. test_decomp_equals) return + + end select + + end function test_decomp_equals + + logical function test_physical_params_equals(this, a) + class (TripolarGridFactory), intent(in) :: this + class (AbstractGridFactory), intent(in) :: a + + select type (a) + class default + test_physical_params_equals = .false. + return + class is (TripolarGridFactory) + test_physical_params_equals = .true. + + test_physical_params_equals = (a%grid_file_name == this%grid_file_name) + if (.not. test_physical_params_equals) return + + test_physical_params_equals = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. test_physical_params_equals) return + + end select + + end function test_physical_params_equals + logical function equals(a, b) class (TripolarGridFactory), intent(in) :: a @@ -578,17 +620,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%test_decomp_equals(b) if (.not. equals) return - - ! same decomposition - equals = a%nx == b%nx .and. a%ny == b%ny + + equals = a%test_physical_params_equals(b) if (.not. equals) return end select @@ -906,13 +944,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 +997,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 From 1a311fb56b7774de78dcdbadcc7d5686fcd3f2e0 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 22 Jul 2021 15:28:13 -0400 Subject: [PATCH 08/14] update change log and check that attributes are the correct size --- CHANGELOG.md | 5 + base/MAPL_OldCubedSphereGridFactory.F90 | 966 ------------------------ base/MAPL_newCFIO.F90 | 7 +- pfio/UnlimitedEntity.F90 | 10 +- 4 files changed, 17 insertions(+), 971 deletions(-) delete mode 100644 base/MAPL_OldCubedSphereGridFactory.F90 diff --git a/CHANGELOG.md b/CHANGELOG.md index 3dbecfc17627..283f0027e2d2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,11 +8,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] ### Removed + +- Removed MAPL_OldCubedShereGridFactory.F90 and consilidated with MAPL_CubedSphereGridFactory.F90 + ### Added - Unit tests can now use the `_RC` macro for checking results from calls to ESMF. The file must first CPP define either `I_AM_PFUNIT` or `I_AM_FUNIT` (serial) and then `#include "MAPL_ErrLog.h"`. +- Add stretch parameters to restarts and check the file grid compared to MAPL grid + when reading restarts ### Changed 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_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/pfio/UnlimitedEntity.F90 b/pfio/UnlimitedEntity.F90 index 4b21aa8a1b72..95cc8cce8040 100644 --- a/pfio/UnlimitedEntity.F90 +++ b/pfio/UnlimitedEntity.F90 @@ -266,6 +266,8 @@ function get_value(this, rc) result(value) class default value => q end select + else if (allocated(this%values)) then + _ASSERT(.false.,"Attribute is array") else value => null() end if @@ -280,6 +282,8 @@ function get_values(this, rc) result(values) if (allocated(this%values)) then values => this%values + else if (allocated(this%value)) then + _ASSERT(.false.,"Asttribute is scalar") else values => null() end if @@ -333,7 +337,7 @@ function is_empty(this, rc) result(yes) integer, optional, intent(out) :: rc logical :: yes - class (*), pointer :: value + class (*), pointer :: value(:) ! not initialized yes = .not. allocated(this%shape) @@ -342,11 +346,11 @@ function is_empty(this, rc) result(yes) endif ! initialized with UnlimitedEnity('') - value => this%get_value() + value => this%get_values() if (associated(value)) then select type (q=>value) type is (character(len=*)) - yes = (q == '') + yes = (q(1) == '') end select end if From 8304740f164c2836bf72e0b71ba9e55ae390ca5b Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 22 Jul 2021 16:16:46 -0400 Subject: [PATCH 09/14] change names for readability --- base/MAPL_AbstractGridFactory.F90 | 12 +++--- base/MAPL_CubedSphereGridFactory.F90 | 54 +++++++++++++------------ base/MAPL_ExternalGridFactory.F90 | 22 +++++----- base/MAPL_Generic.F90 | 2 +- base/MAPL_LatLonGridFactory.F90 | 60 ++++++++++++++-------------- base/MAPL_LlcGridFactory.F90 | 38 +++++++++--------- base/MAPL_TripolarGridFactory.F90 | 38 +++++++++--------- 7 files changed, 118 insertions(+), 108 deletions(-) diff --git a/base/MAPL_AbstractGridFactory.F90 b/base/MAPL_AbstractGridFactory.F90 index 17bf2fd2c1ae..a83b41fed7f0 100644 --- a/base/MAPL_AbstractGridFactory.F90 +++ b/base/MAPL_AbstractGridFactory.F90 @@ -79,8 +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(test_decomp_equals), deferred :: test_decomp_equals - procedure(test_physical_params_equals), deferred :: test_physical_params_equals + procedure(decomps_are_equal), deferred :: decomps_are_equal + procedure(physical_params_are_equal), deferred :: physical_params_are_equal end type AbstractGridFactory abstract interface @@ -91,17 +91,17 @@ logical function equals(a, b) class (AbstractGridFactory), intent(in) :: b end function equals - logical function test_decomp_equals(this,a) + logical function decomps_are_equal(this,a) import AbstractGridFactory class (AbstractGridFactory), intent(in) :: this class (AbstractGridFactory), intent(in) :: a - end function test_decomp_equals + end function decomps_are_equal - logical function test_physical_params_equals(this,a) + logical function physical_params_are_equal(this,a) import AbstractGridFactory class (AbstractGridFactory), intent(in) :: this class (AbstractGridFactory), intent(in) :: a - end function test_physical_params_equals + end function physical_params_are_equal function make_new_grid(this, unusable, rc) result(grid) use esmf diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index 2e126b453e22..58c8ee270786 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -93,8 +93,8 @@ module MAPL_CubedSphereGridFactoryMod procedure :: generate_file_reference3D procedure :: get_fake_longitudes procedure :: get_fake_latitudes - procedure :: test_decomp_equals - procedure :: test_physical_params_equals + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type CubedSphereGridFactory character(len=*), parameter :: MOD_NAME = 'CubedSphereGridFactory::' @@ -771,60 +771,62 @@ elemental subroutine set_with_default_bounds(to, from, default) end subroutine set_with_default_bounds - logical function test_decomp_equals(this, a) + 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 - test_decomp_equals = .false. + equal = .false. class is (CubedSphereGridFactory) - test_decomp_equals = .true. - test_decomp_equals = all(a%ims == this%ims) - if (.not. test_decomp_equals) return + 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) - test_decomp_equals = a_nx*a_ny == b_nx*b_ny - if (.not. test_decomp_equals) return + equal = a_nx*a_ny == b_nx*b_ny + if (.not. equal) return else - test_decomp_equals = all(a%jms_2d == this%jms_2d) - if (.not. test_decomp_equals) return + equal = all(a%jms_2d == this%jms_2d) + if (.not. equal) return endif end select - end function test_decomp_equals + end function decomps_are_equal - logical function test_physical_params_equals(this, a) + 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 - test_physical_params_equals = .false. + equal = .false. return class is (CubedSphereGridFactory) - test_physical_params_equals = .true. + equal = .true. - test_physical_params_equals = (a%im_world == this%im_world) - if (.not. test_physical_params_equals) return + equal = (a%im_world == this%im_world) + if (.not. equal) return - test_physical_params_equals = (a%stretch_factor == this%stretch_factor) - if (.not. test_physical_params_equals) return + equal = (a%stretch_factor == this%stretch_factor) + if (.not. equal) return - test_physical_params_equals = (a%target_lon == this%target_lon) - if (.not. test_physical_params_equals) return + equal = (a%target_lon == this%target_lon) + if (.not. equal) return - test_physical_params_equals = (a%target_lat == this%target_lat) - if (.not. test_physical_params_equals) return + equal = (a%target_lat == this%target_lat) + if (.not. equal) return end select - end function test_physical_params_equals + end function physical_params_are_equal logical function equals(a, b) class (CubedSphereGridFactory), intent(in) :: a @@ -841,10 +843,10 @@ logical function equals(a, b) equals = (a%lm == b%lm) if (.not. equals) return - equals = a%test_decomp_equals(b) + equals = a%decomps_are_equal(b) if (.not. equals) return - equals = a%test_physical_params_equals(b) + equals = a%physical_params_are_equal(b) if (.not. equals) return end select diff --git a/base/MAPL_ExternalGridFactory.F90 b/base/MAPL_ExternalGridFactory.F90 index 19d584c95361..9182156c335e 100644 --- a/base/MAPL_ExternalGridFactory.F90 +++ b/base/MAPL_ExternalGridFactory.F90 @@ -44,8 +44,8 @@ module MAPL_ExternalGridFactoryMod procedure :: generate_file_corner_bounds procedure :: generate_file_reference2D procedure :: generate_file_reference3D - procedure :: test_decomp_equals - procedure :: test_physical_params_equals + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type ExternalGridFactory interface ExternalGridFactory @@ -107,33 +107,35 @@ function make_new_grid(this, unusable, rc) result(grid) _RETURN(_SUCCESS) end function make_new_grid - logical function test_decomp_equals(this,a) + 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 - test_decomp_equals = .false. + equal = .false. return class is (ExternalGridFactory) - test_decomp_equals = .true. + equal = .true. end select - end function test_decomp_equals + end function decomps_are_equal - logical function test_physical_params_equals(this,a) + 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 - test_physical_params_equals = .false. + equal = .false. return class is (ExternalGridFactory) - test_physical_params_equals = .true. + equal = .true. end select - end function test_physical_params_equals + end function physical_params_are_equal logical function equals(a, b) class(ExternalGridFactory), intent(in) :: a diff --git a/base/MAPL_Generic.F90 b/base/MAPL_Generic.F90 index 34695e927a12..74a4f50112fe 100644 --- a/base/MAPL_Generic.F90 +++ b/base/MAPL_Generic.F90 @@ -5900,7 +5900,7 @@ subroutine MAPL_ESMFStateReadFromFile(STATE,CLOCK,FILENAME,MPL,HDR,RC) else app_factory => get_factory(MPL%GRID%ESMFGRID) allocate(file_factory,source=grid_manager%make_factory(trim(filename))) - _ASSERT(file_factory%test_physical_params_equals(app_factory),"Factories not equal") + _ASSERT(file_factory%physical_params_are_equal(app_factory),"Factories not equal") call ArrDescrSetNCPar(arrdes,MPL,num_readers=mpl%grid%num_readers,RC=STATUS) _VERIFY(STATUS) end if PNC4_TILE diff --git a/base/MAPL_LatLonGridFactory.F90 b/base/MAPL_LatLonGridFactory.F90 index 08627783d387..7b6b901a35d2 100644 --- a/base/MAPL_LatLonGridFactory.F90 +++ b/base/MAPL_LatLonGridFactory.F90 @@ -96,8 +96,8 @@ module MAPL_LatLonGridFactoryMod procedure :: generate_file_corner_bounds procedure :: generate_file_reference2D procedure :: generate_file_reference3D - procedure :: test_decomp_equals - procedure :: test_physical_params_equals + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type LatLonGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_LatLonGridFactory::' @@ -1389,65 +1389,67 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, end subroutine initialize_from_esmf_distGrid - logical function test_decomp_equals(this,a) + function decomps_are_equal(this,a) result(equal) class (LatLonGridFactory), intent(in) :: this class (AbstractGridFactory), intent(in) :: a + logical :: equal select type (a) class default - test_decomp_equals = .false. + equal = .false. return class is (LatLonGridFactory) - test_decomp_equals = .true. + equal = .true. - test_decomp_equals = size(a%ims)==size(this%ims) .and. size(a%jms)==size(this%jms) - if (.not. test_decomp_equals) return + equal = size(a%ims)==size(this%ims) .and. size(a%jms)==size(this%jms) + if (.not. equal) return ! same decomposition - test_decomp_equals = all(a%ims == this%ims) .and. all(a%jms == this%jms) - if (.not. test_decomp_equals) return + equal = all(a%ims == this%ims) .and. all(a%jms == this%jms) + if (.not. equal) return end select - end function test_decomp_equals + end function decomps_are_equal - logical function test_physical_params_equals(this, a) + 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 - test_physical_params_equals = .false. + equal = .false. return class is (LatLonGridFactory) - test_physical_params_equals = .true. + equal = .true. - test_physical_params_equals = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) - if (.not. test_physical_params_equals) return + equal = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. equal) return - test_physical_params_equals = (a%is_regular .eqv. this%is_regular) - if (.not. test_physical_params_equals) return + equal = (a%is_regular .eqv. this%is_regular) + if (.not. equal) return if (a%is_regular) then - test_physical_params_equals = (a%pole == this%pole) - if (.not. test_physical_params_equals) return + equal = (a%pole == this%pole) + if (.not. equal) return - test_physical_params_equals = (a%dateline == this%dateline) - if (.not. test_physical_params_equals) return + equal = (a%dateline == this%dateline) + if (.not. equal) return if (a%pole == 'XY') then - test_physical_params_equals = (a%lat_range == this%lat_range) - if (.not. test_physical_params_equals) return + equal = (a%lat_range == this%lat_range) + if (.not. equal) return end if if (a%dateline == 'XY') then - test_physical_params_equals = (a%lon_range == this%lon_range) - if (.not. test_physical_params_equals) return + equal = (a%lon_range == this%lon_range) + if (.not. equal) return end if else - test_physical_params_equals = & + 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. & @@ -1455,7 +1457,7 @@ logical function test_physical_params_equals(this, a) end if end select - end function test_physical_params_equals + end function physical_params_are_equal logical function equals(a, b) class (LatLonGridFactory), intent(in) :: a @@ -1471,10 +1473,10 @@ logical function equals(a, b) equals = (a%lm == b%lm) if (.not. equals) return - equals = a%test_decomp_equals(b) + equals = a%decomps_are_equal(b) if (.not. equals) return - equals = a%test_physical_params_equals(b) + equals = a%physical_params_are_equal(b) if (.not. equals) return end select diff --git a/base/MAPL_LlcGridFactory.F90 b/base/MAPL_LlcGridFactory.F90 index 0bf1f5d0b17e..e20ae3a54f85 100644 --- a/base/MAPL_LlcGridFactory.F90 +++ b/base/MAPL_LlcGridFactory.F90 @@ -73,8 +73,8 @@ module MAPL_LlcGridFactoryMod procedure :: generate_file_corner_bounds procedure :: generate_file_reference2D procedure :: generate_file_reference3D - procedure :: test_decomp_equals - procedure :: test_physical_params_equals + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type LlcGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_LlcGridFactory::' @@ -509,46 +509,48 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, _FAIL('unsupported') end subroutine initialize_from_esmf_distGrid - logical function test_decomp_equals(this,a) + 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 - test_decomp_equals = .false. + equal = .false. return class is (LlcGridFactory) - test_decomp_equals = .true. + equal = .true. ! same decomposition - test_decomp_equals = a%nx == this%nx .and. a%ny == this%ny - if (.not. test_decomp_equals) return + equal = a%nx == this%nx .and. a%ny == this%ny + if (.not. equal) return end select - end function test_decomp_equals + end function decomps_are_equal - logical function test_physical_params_equals(this, a) + 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 - test_physical_params_equals = .false. + equal = .false. return class is (LlcGridFactory) - test_physical_params_equals = .true. + equal = .true. - test_physical_params_equals = (a%grid_file_name == this%grid_file_name) - if (.not. test_physical_params_equals) return + equal = (a%grid_file_name == this%grid_file_name) + if (.not. equal) return - test_physical_params_equals = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) - if (.not. test_physical_params_equals) return + equal = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. equal) return end select - end function test_physical_params_equals + end function physical_params_are_equal logical function equals(a, b) @@ -565,10 +567,10 @@ logical function equals(a, b) equals = (a%lm == b%lm) if (.not. equals) return - equals = a%test_decomp_equals(b) + equals = a%decomps_are_equal(b) if (.not. equals) return - equals = a%test_physical_params_equals(b) + equals = a%physical_params_are_equal(b) if (.not. equals) return end select diff --git a/base/MAPL_TripolarGridFactory.F90 b/base/MAPL_TripolarGridFactory.F90 index 9e96dba90653..783dd40b3b00 100644 --- a/base/MAPL_TripolarGridFactory.F90 +++ b/base/MAPL_TripolarGridFactory.F90 @@ -66,8 +66,8 @@ module MAPL_TripolarGridFactoryMod procedure :: generate_file_corner_bounds procedure :: generate_file_reference2D procedure :: generate_file_reference3D - procedure :: test_decomp_equals - procedure :: test_physical_params_equals + procedure :: decomps_are_equal + procedure :: physical_params_are_equal end type TripolarGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_TripolarGridFactory::' @@ -567,46 +567,48 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, end subroutine initialize_from_esmf_distGrid - logical function test_decomp_equals(this,a) + 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 - test_decomp_equals = .false. + equal = .false. return class is (TripolarGridFactory) - test_decomp_equals = .true. + equal = .true. ! same decomposition - test_decomp_equals = a%nx == this%nx .and. a%ny == this%ny - if (.not. test_decomp_equals) return + equal = a%nx == this%nx .and. a%ny == this%ny + if (.not. equal) return end select - end function test_decomp_equals + end function decomps_are_equal - logical function test_physical_params_equals(this, a) + 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 - test_physical_params_equals = .false. + equal = .false. return class is (TripolarGridFactory) - test_physical_params_equals = .true. + equal = .true. - test_physical_params_equals = (a%grid_file_name == this%grid_file_name) - if (.not. test_physical_params_equals) return + equal = (a%grid_file_name == this%grid_file_name) + if (.not. equal) return - test_physical_params_equals = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) - if (.not. test_physical_params_equals) return + equal = (a%im_world == this%im_world) .and. (a%jm_world == this%jm_world) + if (.not. equal) return end select - end function test_physical_params_equals + end function physical_params_are_equal logical function equals(a, b) @@ -623,10 +625,10 @@ logical function equals(a, b) equals = (a%lm == b%lm) if (.not. equals) return - equals = a%test_decomp_equals(b) + equals = a%decomps_are_equal(b) if (.not. equals) return - equals = a%test_physical_params_equals(b) + equals = a%physical_params_are_equal(b) if (.not. equals) return end select From c163b82b77db3a8fdb155ad41d1ca14cead19948 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 23 Jul 2021 11:09:30 -0400 Subject: [PATCH 10/14] fix unit tests and fix changelog. Undid pfio check as it was causing a problem with one of the tests --- CHANGELOG.md | 5 +++-- base/tests/MockGridFactory.F90 | 34 ++++++++++++++++++++++++++++++++-- pfio/UnlimitedEntity.F90 | 10 +++------- 3 files changed, 38 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6359ee23e191..a029d09aa50d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +- Add stretch parameters to restarts and check the file grid compared to MAPL grid + when reading restarts + ### Removed - Removed MAPL_OldCubedShereGridFactory.F90 and consilidated with MAPL_CubedSphereGridFactory.F90 @@ -27,8 +30,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Unit tests can now use the `_RC` macro for checking results from calls to ESMF. The file must first CPP define either `I_AM_PFUNIT` or `I_AM_FUNIT` (serial) and then `#include "MAPL_ErrLog.h"`. -- Add stretch parameters to restarts and check the file grid compared to MAPL grid - when reading restarts ### Changed 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/pfio/UnlimitedEntity.F90 b/pfio/UnlimitedEntity.F90 index 95cc8cce8040..4b21aa8a1b72 100644 --- a/pfio/UnlimitedEntity.F90 +++ b/pfio/UnlimitedEntity.F90 @@ -266,8 +266,6 @@ function get_value(this, rc) result(value) class default value => q end select - else if (allocated(this%values)) then - _ASSERT(.false.,"Attribute is array") else value => null() end if @@ -282,8 +280,6 @@ function get_values(this, rc) result(values) if (allocated(this%values)) then values => this%values - else if (allocated(this%value)) then - _ASSERT(.false.,"Asttribute is scalar") else values => null() end if @@ -337,7 +333,7 @@ function is_empty(this, rc) result(yes) integer, optional, intent(out) :: rc logical :: yes - class (*), pointer :: value(:) + class (*), pointer :: value ! not initialized yes = .not. allocated(this%shape) @@ -346,11 +342,11 @@ function is_empty(this, rc) result(yes) endif ! initialized with UnlimitedEnity('') - value => this%get_values() + value => this%get_value() if (associated(value)) then select type (q=>value) type is (character(len=*)) - yes = (q(1) == '') + yes = (q == '') end select end if From a7c3dd967886fff81ea6620a6f13f0c6600c1f42 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 26 Jul 2021 16:03:16 -0400 Subject: [PATCH 11/14] fixes #928 --- base/MAPL_Generic.F90 | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/base/MAPL_Generic.F90 b/base/MAPL_Generic.F90 index 74a4f50112fe..6761f45e2731 100644 --- a/base/MAPL_Generic.F90 +++ b/base/MAPL_Generic.F90 @@ -5657,6 +5657,7 @@ subroutine MAPL_ESMFStateReadFromFile(STATE,CLOCK,FILENAME,MPL,HDR,RC) logical :: is_tile class(AbstractGridFactory), pointer :: app_factory class (AbstractGridFactory), allocatable :: file_factory + character(len=ESMF_MAXSTR) :: grid_type _UNUSED_DUMMY(CLOCK) @@ -5898,9 +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 - 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") + 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 From 7f84c5fb3ad04447a371a20d473dc21431902270 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 26 Jul 2021 16:05:55 -0400 Subject: [PATCH 12/14] update changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index a029d09aa50d..52d10ba8c2ca 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed ### 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 From 60eec4b2646bf582e78b249b2df73a16afde8ae7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 27 Jul 2021 08:52:50 -0400 Subject: [PATCH 13/14] Widen throughput timer format --- CHANGELOG.md | 3 +++ gridcomps/Cap/MAPL_CapGridComp.F90 | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 52d10ba8c2ca..9830640dd0d7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - 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 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) From 31adbe9d1451c85984dd159a1b52661e00b67b03 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 28 Jul 2021 11:23:11 -0400 Subject: [PATCH 14/14] Prepare CHANGELOG and version for MAPL 2.8.1 release --- CHANGELOG.md | 10 ++++++++-- CMakeLists.txt | 2 +- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9830640dd0d7..e9d5b5d36671 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,8 +7,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] -- Add stretch parameters to restarts and check the file grid compared to MAPL grid - when reading restarts +### Removed +### Added +### Changed +### Fixed + +## [2.8.1] - 2021-07-28 ### Removed @@ -16,6 +20,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### 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` 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