diff --git a/.circleci/config.yml b/.circleci/config.yml index 0a1c854571f0..0de92fb286bb 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -17,11 +17,11 @@ parameters: # Anchors to prevent forgetting to update a version os_version: &os_version ubuntu20 baselibs_version: &baselibs_version v7.25.0 -bcs_version: &bcs_version v11.5.0 +bcs_version: &bcs_version v11.6.0 tag_build_arg_name: &tag_build_arg_name maplversion orbs: - ci: geos-esm/circleci-tools@2 + ci: geos-esm/circleci-tools@4 workflows: build-and-test-MAPL: @@ -136,7 +136,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran,ifort] + compiler: [gfortran, ifort] baselibs_version: *baselibs_version repo: GEOSldas mepodevelop: false @@ -171,7 +171,7 @@ workflows: filters: tags: only: /^v.*$/ - name: publish-intel-docker-image + name: publish-ifort-docker-image context: - docker-hub-creds - ghcr-creds @@ -180,10 +180,27 @@ workflows: container_name: mapl mpi_name: intelmpi mpi_version: "2021.13" - compiler_name: intel - compiler_version: "2024.2" + compiler_name: ifort + compiler_version: "2021.13" image_name: geos-env tag_build_arg_name: *tag_build_arg_name + #- ci/publish_docker: + #filters: + #tags: + #only: /^v.*$/ + #name: publish-ifx-docker-image + #context: + #- docker-hub-creds + #- ghcr-creds + #os_version: *os_version + #baselibs_version: *baselibs_version + #container_name: mapl + #mpi_name: intelmpi + #mpi_version: "2021.13" + #compiler_name: ifx + #compiler_version: "2024.2" + #image_name: geos-env + #tag_build_arg_name: *tag_build_arg_name - ci/publish_docker: filters: tags: diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 49df23351b89..c7f3aedd05bf 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -5,11 +5,3 @@ # The MAPL Team owns all the files * @GEOS-ESM/mapl-team - -# The Python Transition Team will own Python files -# until the Python 3 transition is completed -*.py @GEOS-ESM/python-transition-team - -# The GEOS CMake Team is the CODEOWNER for the CMakeLists.txt files in this repository -CMakeLists.txt @GEOS-ESM/cmake-team - diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 76ed2d251565..d6c9d61fbf4d 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -86,7 +86,7 @@ jobs: name: Build and Test MAPL Intel runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env:v7.25.0-intelmpi_2021.13-intel_2024.2 + image: gmao/ubuntu20-geos-env:v7.25.0-intelmpi_2021.13-ifort_2021.13 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests diff --git a/Apps/CMakeLists.txt b/Apps/CMakeLists.txt index c0fa7dd74c97..c9e78e434187 100644 --- a/Apps/CMakeLists.txt +++ b/Apps/CMakeLists.txt @@ -26,25 +26,13 @@ install( DESTINATION bin/forcing_converter) ecbuild_add_executable (TARGET Regrid_Util.x SOURCES Regrid_Util.F90) -target_link_libraries (Regrid_Util.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF) +target_link_libraries (Regrid_Util.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (Regrid_Util.x PRIVATE $) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(Regrid_Util.x PRIVATE OpenMP::OpenMP_Fortran) -endif () ecbuild_add_executable (TARGET time_ave_util.x SOURCES time_ave_util.F90) -target_link_libraries (time_ave_util.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF) +target_link_libraries (time_ave_util.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (time_ave_util.x PRIVATE $) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(time_ave_util.x PRIVATE OpenMP::OpenMP_Fortran) -endif () ecbuild_add_executable (TARGET Comp_Testing_Driver.x SOURCES Comp_Testing_Driver.F90) -target_link_libraries (Comp_Testing_Driver.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF) +target_link_libraries (Comp_Testing_Driver.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (Comp_Testing_Driver.x PRIVATE $) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(Comp_Testing_Driver.x PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/Apps/Regrid_Util.F90 b/Apps/Regrid_Util.F90 index 8b4810c4d073..072ab7373b96 100644 --- a/Apps/Regrid_Util.F90 +++ b/Apps/Regrid_Util.F90 @@ -96,7 +96,7 @@ subroutine process_command_line(this,rc) this%lat_range=uninit this%shave=64 this%deflate=0 - this%quantize_algorithm=1 + this%quantize_algorithm=0 this%quantize_level=0 this%use_weights = .false. nargs = command_argument_count() @@ -424,6 +424,7 @@ subroutine main() call t_prof%stop("Read") call MPI_BARRIER(MPI_COMM_WORLD,STATUS) + _VERIFY(status) call t_prof%start("write") diff --git a/Apps/time_ave_util.F90 b/Apps/time_ave_util.F90 index 756c3250e70d..c17b82360863 100644 --- a/Apps/time_ave_util.F90 +++ b/Apps/time_ave_util.F90 @@ -133,9 +133,13 @@ program time_ave !call timebeg ('main') - call mpi_init ( ierror ) ; comm = mpi_comm_world + call mpi_init ( ierror ) + _VERIFY(ierror) + comm = mpi_comm_world call mpi_comm_rank ( comm,myid,ierror ) + _VERIFY(ierror) call mpi_comm_size ( comm,npes,ierror ) + _VERIFY(ierror) call ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE,mpiCommunicator=MPI_COMM_WORLD, _RC) call MAPL_Initialize(_RC) t_prof = DistributedProfiler('time_ave_util',MpiTImerGauge(),MPI_COMM_WORLD) @@ -813,6 +817,7 @@ program time_ave enddo ! End ntime Loop within file call MPI_BARRIER(comm,status) + _VERIFY(status) enddo do k=0,ntods @@ -1064,7 +1069,9 @@ program time_ave endif call mpi_reduce( qmin(nloc(n)+L-1),qming,1,mpi_real,mpi_min,0,comm,ierror ) + _VERIFY(ierror) call mpi_reduce( qmax(nloc(n)+L-1),qmaxg,1,mpi_real,mpi_max,0,comm,ierror ) + _VERIFY(ierror) if( root ) then if(L.eq.1) then write(6,3101) trim(vname2(n)),plev,qming,qmaxg @@ -1076,6 +1083,7 @@ program time_ave 3102 format(1x,' ',a20,' Level: ',f9.3,' Min: ',g15.8,' Max: ',g15.8) enddo call MPI_BARRIER(comm,status) + _VERIFY(status) if( root ) print * enddo if( root ) print * @@ -1676,7 +1684,7 @@ end function is_leap_year subroutine usage(root) logical, intent(in) :: root - integer :: status,errorcode + integer :: status,errorcode,rc if(root) then write(6,100) 100 format( "usage: ",/,/ & @@ -1710,6 +1718,7 @@ subroutine usage(root) ) endif call MPI_Abort(MPI_COMM_WORLD,errorcode,status) + _VERIFY(status) end subroutine usage subroutine generate_report() diff --git a/CHANGELOG.md b/CHANGELOG.md index bbf0a9e62f6d..1c5c4fdae965 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,67 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.48.0] - 2024-09-24 + +### Added + +- Added 5 new ExtData tests to test compression, bit-shaving, and quantization + +### Changed + +- Rename all single-digit ExtData tests to have a leading zero (i.e., `case1` -> `case01`) +- Add restart benchmark code `restart_simulator.x` in benchmark directory +- Start implementing changes for vertical regridding in ExtData +- Made the POSITIVE field attribute defaults to "down" in case it is not found +- VLOCATION is not querried in MAPL_VerticalMethods.F90 for rank 2 fields +- Fixed time print in Cap GC (from slashes to colons) +- Added ability to read the attribute with explicit type "string" of a netcdf variable. +- Add ability to connect export of the MAPL hierachy to ExtData via CAP.rc file +- Added new driver, CapDriver.x, to excerise the MAPL_Cap with the configuratable component also used by ExtDataDriver.x +- Added Fortran interface to UDUNITS2 + - NOTE: This now means MAPL depends on UDUNITS2 (and transitively, expat) +- Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) +- CI Updates + - Update Baselibs in CI to 7.25.0 + - Update to circleci-tools orb v4 + - This adds the ability to do an `ifx` test along with the `ifort` test (though `ifx` is not yet enabled) +- Update `components.yaml` + - ESMA_env v4.30.1 + - Update to Baselibs 7.25.0 + - ESMF 8.6.1 + - GFE v1.16.0 + - gFTL v1.14.0 + - gFTL-shared v1.9.0 + - fArgParse v1.8.0 + - pFUnit v4.10.0 + - yaFyaml v1.4.0 + - curl 8.8.0 + - NCO 5.2.6 + - Other various fixes from the v8 branch + - Move to use Intel ifort 2021.13 at NCCS SLES15, NAS, and GMAO Desktops + - Move to use Intel MPI at NCCS SLES15 and GMAO Desktops + - Move to GEOSpyD Min24.4.4 Python 3.11 + - Fix for csh at NAS + - ESMA_cmake v3.51.0 + - Update `esma_add_fortran_submodules` function + - Move MPI detection out of FindBaselibs + - Add SMOD to submodule generator + - NAG OpenMP Workaround + - Support for Jemalloc and LLVM Flang +- Add support for preliminary CF Conventions quantization properties + - Add new quantization keyword `granular_bitround` to History. This will be the preferred keyword for quantization in the future + replacing `GranularBR` + +### Fixed + +- Fix profiler PercentageColumn test for GCC 14 +- Fix bug in ExtData Tests. CMake was overwriting the `EXTDATA2G_SMALL_TESTS` LABEL with `ESSENTIAL` + +### Deprecated + +- Deprecate `GranularBR` as a quantization method keyword in History. We will prefer `granular_bitround` in the future to match + draft CF conventions. This will be removed in MAPL 3. + ## [2.47.2] - 2024-08-16 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index febab17e3ed3..212ffb6e0d23 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.47.2 + VERSION 2.48.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui @@ -218,6 +218,7 @@ if (APPLE) add_compile_definitions("-D__DARWIN") endif() +add_subdirectory (udunits2f) add_subdirectory (pfio) add_subdirectory (profiler) add_subdirectory (generic) diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index ebb0dcb2122d..e35cec9332d0 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -1,38 +1,32 @@ +esma_set_this (OVERRIDE MAPL.test_utilities) + set(MODULE_DIRECTORY "${esma_include}/Tests") set (srcs - ExtDataDriverGridComp.F90 ExtDataRoot_GridComp.F90 - ExtDataDriver.F90 - ExtDataDriverMod.F90 VarspecDescription.F90 ) +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL NetCDF::NetCDF_Fortran NetCDF::NetCDF_C TYPE ${MAPL_LIBRARY_TYPE}) + if (BUILD_WITH_FARGPARSE) - ecbuild_add_executable (TARGET ExtDataDriver.x SOURCES ${srcs}) - target_link_libraries (ExtDataDriver.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF) - # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 - if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(ExtDataDriver.x PRIVATE OpenMP::OpenMP_Fortran) - endif () + ecbuild_add_executable (TARGET ExtDataDriver.x SOURCES ExtDataDriver.F90 ExtDataDriverGridComp.F90 ExtDataDriverMod.F90) + target_link_libraries (ExtDataDriver.x PRIVATE MAPL MAPL.test_utilities FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) set_target_properties(ExtDataDriver.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) target_compile_definitions (ExtDataDriver.x PRIVATE $<$:BUILD_WITH_EXTDATA2G>) add_subdirectory(ExtData_Testing_Framework EXCLUDE_FROM_ALL) ecbuild_add_executable (TARGET pfio_MAPL_demo.x SOURCES pfio_MAPL_demo.F90) - target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF) - # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 - if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(pfio_MAPL_demo.x PRIVATE OpenMP::OpenMP_Fortran) - endif () + target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) set_target_properties(pfio_MAPL_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + ecbuild_add_executable (TARGET MAPL_demo_fargparse.x SOURCES MAPL_demo_fargparse.F90) - target_link_libraries (MAPL_demo_fargparse.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF) - # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 - if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(MAPL_demo_fargparse.x PRIVATE OpenMP::OpenMP_Fortran) - endif () + target_link_libraries (MAPL_demo_fargparse.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) set_target_properties(MAPL_demo_fargparse.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + ecbuild_add_executable (TARGET CapDriver.x SOURCES CapDriver.F90) + target_link_libraries (CapDriver.x PRIVATE MAPL MAPL.test_utilities FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) + set_target_properties(CapDriver.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + endif () diff --git a/Tests/CapDriver.F90 b/Tests/CapDriver.F90 new file mode 100644 index 000000000000..cadc059779da --- /dev/null +++ b/Tests/CapDriver.F90 @@ -0,0 +1,24 @@ +#define I_AM_MAIN + +#include "MAPL_Generic.h" + +program CapDriver_Main + use MPI + use MAPL + use ExtDataUtRoot_GridCompMod, only: ROOT_SetServices => SetServices + implicit none + + character(len=*), parameter :: Iam="CapDriver_Main" + type (MAPL_Cap) :: cap + type (MAPL_FargparseCLI) :: cli + type (MAPL_CapOptions) :: cap_options + integer :: status + + cli = MAPL_FargparseCLI() + cap_options = MAPL_CapOptions(cli) + cap = MAPL_Cap('Root', ROOT_SetServices, cap_options = cap_options) + + call cap%run(_RC) + +end program CapDriver_Main + diff --git a/Tests/ExtDataDriverMod.F90 b/Tests/ExtDataDriverMod.F90 index 757398872933..bf64d653f577 100644 --- a/Tests/ExtDataDriverMod.F90 +++ b/Tests/ExtDataDriverMod.F90 @@ -217,6 +217,7 @@ subroutine initialize_mpi(this, unusable, rc) _UNUSED_DUMMY(unusable) call MPI_Init(ierror) + _VERIFY(ierror) this%comm_world=MPI_COMM_WORLD call MPI_Comm_rank(this%comm_world, this%rank, ierror); _VERIFY(ierror) diff --git a/Tests/ExtData_Testing_Framework/CMakeLists.txt b/Tests/ExtData_Testing_Framework/CMakeLists.txt index 507ff970b7fe..afcb2b5be93f 100644 --- a/Tests/ExtData_Testing_Framework/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framework/CMakeLists.txt @@ -13,7 +13,7 @@ set(cutoff "7") # be skipped for ESSENTIAL testing. Most ExtData tests # take 1-2 seconds at most, but some take 20-30 seconds. set(SLOW_TESTS - "case6" + "case06" "case14" "case15" "case16" @@ -22,6 +22,13 @@ set(SLOW_TESTS "case23" ) +# We have 3 tests that require netcdf Quantize support +set(QUANTIZE_TESTS + "case32" + "case33" + "case34" +) + foreach(TEST_CASE ${TEST_CASES_1G}) if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc) file(READ ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc num_procs) @@ -52,6 +59,11 @@ file(STRINGS "test_cases/extdata_2g_cases.txt" TEST_CASES_2G) foreach(TEST_CASE ${TEST_CASES_2G}) + # Skip tests that require Quantize support if we don't have it + if (NOT NETCDF_HAS_QUANTIZE AND ${TEST_CASE} IN_LIST QUANTIZE_TESTS) + continue() + endif() + if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc) file(READ ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc num_procs) else() @@ -73,7 +85,6 @@ foreach(TEST_CASE ${TEST_CASES_2G}) elseif (${TEST_CASE} IN_LIST SLOW_TESTS) set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SLOW_TESTS") else() - set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS") - set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "ESSENTIAL") + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS;ESSENTIAL") endif() endforeach() diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/README b/Tests/ExtData_Testing_Framework/test_cases/case01/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/README rename to Tests/ExtData_Testing_Framework/test_cases/case01/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case01/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case01/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/README b/Tests/ExtData_Testing_Framework/test_cases/case02/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/README rename to Tests/ExtData_Testing_Framework/test_cases/case02/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case02/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case02/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/README b/Tests/ExtData_Testing_Framework/test_cases/case03/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/README rename to Tests/ExtData_Testing_Framework/test_cases/case03/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case03/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case03/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/README b/Tests/ExtData_Testing_Framework/test_cases/case04/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/README rename to Tests/ExtData_Testing_Framework/test_cases/case04/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case04/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case04/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/README b/Tests/ExtData_Testing_Framework/test_cases/case05/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/README rename to Tests/ExtData_Testing_Framework/test_cases/case05/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case05/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case05/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/README b/Tests/ExtData_Testing_Framework/test_cases/case06/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/README rename to Tests/ExtData_Testing_Framework/test_cases/case06/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case06/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case06/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/README b/Tests/ExtData_Testing_Framework/test_cases/case07/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/README rename to Tests/ExtData_Testing_Framework/test_cases/case07/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case07/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case07/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/README b/Tests/ExtData_Testing_Framework/test_cases/case08/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/README rename to Tests/ExtData_Testing_Framework/test_cases/case08/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case08/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case08/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/README b/Tests/ExtData_Testing_Framework/test_cases/case09/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/README rename to Tests/ExtData_Testing_Framework/test_cases/case09/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case09/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case09/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY1.rc new file mode 100644 index 000000000000..250d183190d6 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY1.rc @@ -0,0 +1,14 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/README b/Tests/ExtData_Testing_Framework/test_cases/case30/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case30/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY1.rc new file mode 100644 index 000000000000..4f4a121f057b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY1.rc @@ -0,0 +1,15 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.nbits: 10, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/README b/Tests/ExtData_Testing_Framework/test_cases/case31/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case31/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY1.rc new file mode 100644 index 000000000000..5dd8d0325c23 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY1.rc @@ -0,0 +1,16 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.quantization_algorithm: 'bitgroom', + case1.quantization_level: 5, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/README b/Tests/ExtData_Testing_Framework/test_cases/case32/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case32/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY1.rc new file mode 100644 index 000000000000..91edade2a3d6 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY1.rc @@ -0,0 +1,16 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.quantization_algorithm: 'bitround', + case1.quantization_level: 10, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/README b/Tests/ExtData_Testing_Framework/test_cases/case33/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case33/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY1.rc new file mode 100644 index 000000000000..8d0e541a189a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY1.rc @@ -0,0 +1,16 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.quantization_algorithm: 'granular_bitround', + case1.quantization_level: 5, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/README b/Tests/ExtData_Testing_Framework/test_cases/case34/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case34/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/extdata_1g_cases.txt b/Tests/ExtData_Testing_Framework/test_cases/extdata_1g_cases.txt index 86154c511a74..8807d45e921f 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/extdata_1g_cases.txt +++ b/Tests/ExtData_Testing_Framework/test_cases/extdata_1g_cases.txt @@ -1,11 +1,11 @@ -case1 -case3 -case4 -case5 -case6 -case7 -case8 -case9 +case01 +case03 +case04 +case05 +case06 +case07 +case08 +case09 case10 case11 case12 diff --git a/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt b/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt index dd87b48b792c..76be9d4d54f8 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt +++ b/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt @@ -1,12 +1,12 @@ -case1 -case2 -case3 -case4 -case5 -case6 -case7 -case8 -case9 +case01 +case02 +case03 +case04 +case05 +case06 +case07 +case08 +case09 case10 case11 case12 @@ -27,3 +27,8 @@ case26 case27 case28 case29 +case30 +case31 +case32 +case33 +case34 diff --git a/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md b/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md index 686e2fc7fc55..f3700c12e5ee 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md +++ b/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md @@ -34,3 +34,8 @@ path_to_script/run_extdatadriver_cases.py --builddir path_to_geos_install/bin -- 27. Case with a "gap" in the data 28. "Replay" type run, update every time 29. "Replay" type run, update once a day with offset +30. Case1 with deflate compression +31. Case1 with deflate compression and MAPL bit-shaving +32. Case1 with deflate compression and NetCDF bitgroom quantization (only enabled if netcdf built with quantization support) +33. Case1 with deflate compression and NetCDF bitround quantization (only enabled if netcdf built with quantization support) +34. Case1 with deflate compression and NetCDF granular_bitround quantization (only enabled if netcdf built with quantization support) diff --git a/Tests/pfio_MAPL_demo.F90 b/Tests/pfio_MAPL_demo.F90 index 6afd8867d56f..aa1a57b57361 100755 --- a/Tests/pfio_MAPL_demo.F90 +++ b/Tests/pfio_MAPL_demo.F90 @@ -1,4 +1,4 @@ - +#define I_AM_MAIN #include "MAPL_ErrLog.h" #include "unused_dummy.H" !------------------------------------------------------------------------------ @@ -91,7 +91,7 @@ program main ! Initialize MPI if MPI_Init has not been called call initialize_mpi(MPI_COMM_WORLD) - call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) if ( cap_options%npes_model == -1) then cap_options%npes_model = npes endif @@ -112,10 +112,10 @@ program main CALL ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE, mpiCommunicator=client_comm, rc=status) ! Get the number of PEs used for the model - call MPi_Comm_size(client_comm, npes, ierror) + call MPi_Comm_size(client_comm, npes, _IERROR) ! Get the PE id - call MPI_Comm_rank(client_comm, pe_id, ierror) + call MPI_Comm_rank(client_comm, pe_id, _IERROR) if (npes /= cap_options%npes_model) stop "sanity check failed" !------------------------------------------------ @@ -155,7 +155,7 @@ program main call ioserver_manager%finalize() - call MPI_finalize(ierror) + call MPI_finalize(_IERROR) !------------------------------------------------------------------------------ CONTAINS diff --git a/base/ApplicationSupport.F90 b/base/ApplicationSupport.F90 index bc895330e0c2..dd0f3edd5ca5 100644 --- a/base/ApplicationSupport.F90 +++ b/base/ApplicationSupport.F90 @@ -118,6 +118,7 @@ subroutine initialize_pflogger(unusable,comm,logging_config,rc) else call MPI_COMM_Rank(comm_world,rank,status) + _VERIFY(status) console = StreamHandler(OUTPUT_UNIT) call console%set_level(INFO) call console%set_formatter(MpiFormatter(comm_world, fmt='%(short_name)a10~: %(message)a')) @@ -186,7 +187,9 @@ subroutine report_global_profiler(unusable,comm,rc) call reporter%add_column(exclusive) call MPI_Comm_size(world_comm, npes, ierror) + _VERIFY(ierror) call MPI_Comm_Rank(world_comm, my_rank, ierror) + _VERIFY(ierror) if (my_rank == 0) then report_lines = reporter%generate_report(t_p) @@ -197,6 +200,7 @@ subroutine report_global_profiler(unusable,comm,rc) end do end if call MPI_Barrier(world_comm, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end subroutine report_global_profiler diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 8f8945af4771..43ffa5fb4f06 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -71,11 +71,7 @@ esma_add_library( GFTL_SHARED::gftl-shared-v2 GFTL_SHARED::gftl-shared-v1 GFTL::gftl-v2 GFTL::gftl-v1 ESMF::ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran TYPE ${MAPL_LIBRARY_TYPE}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) if(DISABLE_GLOBAL_NAME_WARNING) target_compile_options (${this} PRIVATE $<$:${DISABLE_GLOBAL_NAME_WARNING}>) @@ -91,11 +87,7 @@ foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) endforeach() ecbuild_add_executable (TARGET cub2latlon.x SOURCES cub2latlon_regridder.F90 DEPENDS ESMF::ESMF MAPL.shared) -target_link_libraries (cub2latlon.x PRIVATE ${this} MAPL.pfio MPI::MPI_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(cub2latlon.x PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries (cub2latlon.x PRIVATE ${this} MAPL.pfio MPI::MPI_Fortran OpenMP::OpenMP_Fortran) set_target_properties(cub2latlon.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) if (EXTENDED_SOURCE) diff --git a/base/FileIOShared.F90 b/base/FileIOShared.F90 index 3b0d4ed75bd7..3854e48ddbdb 100644 --- a/base/FileIOShared.F90 +++ b/base/FileIOShared.F90 @@ -431,8 +431,10 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers integer :: status - call MPI_Comm_Rank(comm,myid,_IERROR) - call MPI_COMM_Size(comm,npes,_IERROR) + call MPI_Comm_Rank(comm,myid,status) + _VERIFY(status) + call MPI_COMM_Size(comm,npes,status) + _VERIFY(status) allocate(iminw(npes),imaxw(npes),jminw(npes),jmaxw(npes),stat=status) iminw=-1 @@ -489,9 +491,11 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers NX0 = mod(myid,nx) + 1 NY0 = myid/nx + 1 color = nx0 - call MPI_Comm_Split(comm,color,myid,ycomm,_IERROR) + call MPI_Comm_Split(comm,color,myid,ycomm,status) + _VERIFY(status) color = ny0 - call MPI_Comm_Split(comm,color,myid,xcomm,_IERROR) + call MPI_Comm_Split(comm,color,myid,xcomm,status) + _VERIFY(status) ! reader communicators if (num_readers > ny .or. mod(ny,num_readers) /= 0) then _RETURN(ESMF_FAILURE) @@ -502,12 +506,14 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers else color = MPI_UNDEFINED end if - call MPI_COMM_SPLIT(comm,color,myid,readers_comm,_IERROR) + call MPI_COMM_SPLIT(comm,color,myid,readers_comm,status) + _VERIFY(status) if (num_readers==ny) then IOscattercomm = xcomm else j = ny0 - mod(ny0-1,ny_by_readers) - call MPI_Comm_Split(comm,j,myid,IOScattercomm,_IERROR) + call MPI_Comm_Split(comm,j,myid,IOScattercomm,status) + _VERIFY(status) endif ! writer communicators if (num_writers > ny .or. mod(ny,num_writers) /= 0) then @@ -519,12 +525,14 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers else color = MPI_UNDEFINED end if - call MPI_COMM_SPLIT(comm,color,myid,writers_comm,_IERROR) + call MPI_COMM_SPLIT(comm,color,myid,writers_comm,status) + _VERIFY(status) if (num_writers==ny) then IOgathercomm = xcomm else j = ny0 - mod(ny0-1,ny_by_writers) - call MPI_Comm_Split(comm,j,myid,IOgathercomm,_IERROR) + call MPI_Comm_Split(comm,j,myid,IOgathercomm,status) + _VERIFY(status) endif ArrDes%im_world=im_world @@ -537,7 +545,8 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers ArrDes%iogathercomm = iogathercomm ArrDes%xcomm = xcomm ArrDes%ycomm = ycomm - call mpi_comm_rank(arrdes%ycomm,arrdes%myrow,_IERROR) + call mpi_comm_rank(arrdes%ycomm,arrdes%myrow,status) + _VERIFY(status) allocate(arrdes%i1(size(i1)),_STAT) arrdes%i1=i1 @@ -605,23 +614,28 @@ subroutine ArrDescrCreateWriterComm(arrdes, full_comm, num_writers, rc) ny = size(arrdes%j1) _ASSERT(num_writers <= ny,'num writers must be less or equal to than NY') _ASSERT(mod(ny,num_writers)==0,'num writerss must evenly divide NY') - call mpi_comm_rank(full_comm,myid, _IERROR) + call mpi_comm_rank(full_comm,myid, status) + _VERIFY(status) color = arrdes%NX0 - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, status) + _VERIFY(status) color = arrdes%NY0 - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, status) + _VERIFY(status) ny_by_writers = ny/num_writers if (mod(myid,nx*ny/num_writers) == 0) then color = 0 else color = MPI_UNDEFINED endif - call MPI_COMM_SPLIT(full_comm, color, myid, arrdes%writers_comm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, myid, arrdes%writers_comm, status) + _VERIFY(status) if (num_writers==ny) then arrdes%IOgathercomm = arrdes%Xcomm else j = arrdes%NY0 - mod(arrdes%NY0-1,ny_by_writers) - call MPI_COMM_SPLIT(full_comm, j, myid, arrdes%IOgathercomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, j, myid, arrdes%IOgathercomm, status) + _VERIFY(status) endif if (arrdes%writers_comm /= MPI_COMM_NULL) then call mpi_comm_rank(arrdes%writers_comm,writer_rank,status) @@ -648,23 +662,28 @@ subroutine ArrDescrCreateReaderComm(arrdes, full_comm, num_readers, rc) _ASSERT(num_readers <= ny,'num readers must be less than or equal to NY') _ASSERT(mod(ny,num_readers)==0,'num readers must evenly divide NY') - call mpi_comm_rank(full_comm,myid, _IERROR) + call mpi_comm_rank(full_comm,myid, status) + _VERIFY(status) color = arrdes%NX0 - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, status) + _VERIFY(status) color = arrdes%NY0 - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, status) + _VERIFY(status) ny_by_readers = ny/num_readers if (mod(myid,nx*ny/num_readers) == 0) then color = 0 else color = MPI_UNDEFINED endif - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%readers_comm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%readers_comm, status) + _VERIFY(status) if (num_readers==ny) then arrdes%IOscattercomm = arrdes%Xcomm else j = arrdes%NY0 - mod(arrdes%NY0-1,ny_by_readers) - call MPI_COMM_SPLIT(full_comm, j, MYID, arrdes%IOscattercomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, j, MYID, arrdes%IOscattercomm, status) + _VERIFY(status) endif _RETURN(_SUCCESS) diff --git a/base/MAPL_Comms.F90 b/base/MAPL_Comms.F90 index 58aab4a1f02c..d8a98bc834d9 100644 --- a/base/MAPL_Comms.F90 +++ b/base/MAPL_Comms.F90 @@ -677,6 +677,7 @@ subroutine MAPL_CollectiveWait(request, DstArray, rc) call MPI_Recv(request%Var, size(request%Var), MPI_REAL, & request%Root, request%tag, request%comm, & MPI_STATUS_IGNORE, status) + _VERIFY(status) endif k=0 do J=1,request%JM0 diff --git a/base/MAPL_LocStreamMod.F90 b/base/MAPL_LocStreamMod.F90 index a5628dcc7f53..d0f654f73900 100644 --- a/base/MAPL_LocStreamMod.F90 +++ b/base/MAPL_LocStreamMod.F90 @@ -2741,6 +2741,7 @@ subroutine MAPL_LocStreamCreateXform ( Xform, LocStreamOut, LocStreamIn, NAME, M call MPI_GATHER( lNumReceivers, 1, MPI_INTEGER, & allSenders(:,1), 1, MPI_INTEGER, & I-1, Xform%Ptr%Comm, status ) + _VERIFY(status) enddo end block call ESMF_VMBarrier(vm, rc=status) diff --git a/base/MAPL_MemUtils.F90 b/base/MAPL_MemUtils.F90 index 26a0c331fdee..b96c6b6dd339 100755 --- a/base/MAPL_MemUtils.F90 +++ b/base/MAPL_MemUtils.F90 @@ -403,6 +403,7 @@ subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC ) call mem_dump(mhwm, mrss, memused, swapused, commitlimit, committed_as) #endif call MPI_Comm_Size(comm_,npes,status) + _VERIFY(status) if (MAPL_MemUtilsMode == MAPL_MemUtilsModeFull) then lhwm = mhwm; call MPI_AllReduce(lhwm,ghwm,1,MPI_REAL,MPI_MAX,comm_,status) _VERIFY(STATUS) @@ -414,6 +415,7 @@ subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC ) _VERIFY(STATUS) gavg = gavg/npes mstd = (mrss-gavg)**2; call MPI_AllReduce(mstd,gstd,1,MPI_REAL,MPI_SUM,comm_,status) + _VERIFY(STATUS) gstd = sqrt( gstd/npes ) gmax_save = gmax lcommitlimit = commitlimit; call MPI_AllReduce(lcommitlimit,gcommitlimit,1,MPI_REAL,MPI_MAX,comm_,status) @@ -784,6 +786,7 @@ subroutine MAPL_MemReport(comm,file_name,line,decorator,rc) _RETURN(ESMF_SUCCESS) #endif call MPI_Barrier(comm,status) + _VERIFY(status) if (present(decorator)) then extra_message = decorator else @@ -792,6 +795,7 @@ subroutine MAPL_MemReport(comm,file_name,line,decorator,rc) call MAPL_MemUsed(mem_total,mem_used,percent_used) call MAPL_MemCommited(committed_total,committed,percent_committed) call MPI_Comm_Rank(comm,rank,status) + _VERIFY(status) if (rank == 0) write(*,'("Mem report ",A20," ",A30," ",i7," ",f5.1,"% : ",f5.1,"% Mem Comm:Used")')trim(extra_message),file_name,line,percent_committed,percent_used end subroutine diff --git a/base/MAPL_SwathGridFactory.F90 b/base/MAPL_SwathGridFactory.F90 index f931fe52a12f..3ae4e633a54d 100644 --- a/base/MAPL_SwathGridFactory.F90 +++ b/base/MAPL_SwathGridFactory.F90 @@ -551,6 +551,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc ! call ESMF_VMGet(vm, mpiCommunicator=mpic, _RC) call MPI_COMM_RANK(mpic, irank, ierror) + _VERIFY(ierror) if (irank==0) & write(6,'(10(2x,a20,2x,a40,/))') & @@ -690,14 +691,21 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc call MPI_bcast(this%M_file, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) do i=1, this%M_file call MPI_bcast(this%filenames(i), ESMF_MAXSTR, MPI_CHARACTER, 0, mpic, ierror) + _VERIFY(ierror) end do call MPI_bcast(this%epoch_index, 4, MPI_INTEGER8, 0, mpic, ierror) + _VERIFY(ierror) call MPI_bcast(this%im_world, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) call MPI_bcast(this%jm_world, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) call MPI_bcast(this%cell_across_swath, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) call MPI_bcast(this%cell_along_swath, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) ! donot need to bcast this%along_track (root only) @@ -1352,6 +1360,7 @@ subroutine get_xy_subset(this, interval, xy_subset, rc) call ESMF_VmGetCurrent(VM, _RC) call ESMF_VMGet(vm, mpiCommunicator=mpic, _RC) call MPI_COMM_RANK(mpic, irank, ierror) + _VERIFY(ierror) if (irank==0) then ! xtrack @@ -1406,6 +1415,7 @@ subroutine get_xy_subset(this, interval, xy_subset, rc) end if call MPI_bcast(xy_subset, 4, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end subroutine get_xy_subset diff --git a/base/MAPL_VerticalMethods.F90 b/base/MAPL_VerticalMethods.F90 index 6c412c16b28b..2627297bdd1a 100644 --- a/base/MAPL_VerticalMethods.F90 +++ b/base/MAPL_VerticalMethods.F90 @@ -166,8 +166,7 @@ function skip_var(this,field,rc) result(skip) integer :: status character(len=ESMF_MAXSTR) :: name - call ESMF_FieldGet(field,name=name,rc=status) - _VERIFY(status) + call ESMF_FieldGet(field,name=name,_RC) skip = trim(name)==trim(this%vvar) end function skip_var @@ -185,8 +184,7 @@ subroutine setup_eta_to_pressure(this,regrid_handle,output_grid,rc) if (allocated(this%ple3d)) deallocate(this%ple3d) if (allocated(this%pl3d)) deallocate(this%pl3d) - call ESMF_FieldGet(this%interp_var,localde=0,farrayptr=ptr3,rc=status) - _VERIFY(status) + call ESMF_FieldGet(this%interp_var,localde=0,farrayptr=ptr3,_RC) allocate(orig_surface_level(size(ptr3,1),size(ptr3,2)),stat=status) _VERIFY(status) @@ -242,16 +240,14 @@ subroutine setup_eta_to_pressure(this,regrid_handle,output_grid,rc) end if if (present(output_grid)) then _ASSERT(present(regrid_handle),"Must provide regridding handle") - call MAPL_GridGet(output_grid,localCellCountPerDim=counts,rc=status) - _VERIFY(status) + call MAPL_GridGet(output_grid,localCellCountPerDim=counts,_RC) if (.not.allocated(this%surface_level)) then allocate(this%surface_level(counts(1),counts(2)),stat=status) _VERIFY(status) end if end if if (present(regrid_handle)) then - call regrid_handle%regrid(orig_surface_level,this%surface_level,rc=status) - _VERIFY(status) + call regrid_handle%regrid(orig_surface_level,this%surface_level,_RC) end if deallocate(orig_surface_level) @@ -411,11 +407,9 @@ subroutine correct_topo(this,field,rc) call ESMF_FieldGet(field,grid=grid,_RC) has_de = MAPL_GridHasDE(grid,_RC) if (has_de) then - call ESMF_FieldGet(field,rank=rank,rc=status) - _VERIFY(status) + call ESMF_FieldGet(field,rank=rank,_RC) if (rank==3) then - call ESMF_FieldGet(field,0,farrayptr=ptr,rc=status) - _VERIFY(status) + call ESMF_FieldGet(field,0,farrayptr=ptr,_RC) do k=1,size(ptr,3) if (this%ascending) then where(this%surface_level) set_target_properties (${exe} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${exe} PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 index f2d257c21020..96bad4dfd6a5 100644 --- a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 +++ b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 @@ -1,3 +1,4 @@ +#undef I_AM_MAIN #include "MAPL_ErrLog.h" module mapl_checkpoint_support_mod @@ -65,7 +66,7 @@ subroutine set_parameters(this,config_file) type(ESMF_Config) :: config logical :: is_present - integer :: comm_size, status,error_code + integer :: comm_size, status,error_code,rc config = ESMF_ConfigCreate() this%extra_info = .false. @@ -97,7 +98,11 @@ subroutine set_parameters(this,config_file) this%time_writing = 0.d0 this%mpi_time = 0.0 call MPI_COMM_SIZE(MPI_COMM_WORLD,comm_size,status) - if (comm_size /= (this%nx*this%ny*6)) call MPI_Abort(mpi_comm_world,error_code,status) + _VERIFY(status) + if (comm_size /= (this%nx*this%ny*6)) then + call MPI_Abort(mpi_comm_world,error_code,status) + _VERIFY(status) + endif contains @@ -173,12 +178,13 @@ subroutine allocate_n_arrays(this,im,jm) integer, intent(in) :: im integer, intent(in) :: jm - integer :: n,rank,status + integer :: n,rank,status,rc character(len=3) :: formatted_int integer :: seed_size integer, allocatable :: seeds(:) call MPI_COMM_RANK(MPI_COMM_WORLD,rank,status) + _VERIFY(status) call random_seed(size=seed_size) allocate(seeds(seed_size)) seeds = rank @@ -199,10 +205,12 @@ subroutine create_arrays(this) class(test_support), intent(inout) :: this integer, allocatable :: ims(:),jms(:) - integer :: rank, status,comm_size,n,i,j,rank_counter,offset,index_offset + integer :: rank, status,comm_size,n,i,j,rank_counter,offset,index_offset,rc call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) + _VERIFY(status) call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + _VERIFY(status) allocate(this%bundle(this%num_arrays)) ims = this%compute_decomposition(axis=1) jms = this%compute_decomposition(axis=2) @@ -251,16 +259,19 @@ subroutine create_arrays(this) subroutine create_communicators(this) class(test_support), intent(inout) :: this - integer :: myid,status,nx0,ny0,color,j,ny_by_writers,local_ny,key + integer :: myid,status,nx0,ny0,color,j,ny_by_writers,local_ny,key,rc local_ny = this%ny*6 call MPI_Comm_Rank(mpi_comm_world,myid,status) + _VERIFY(status) nx0 = mod(myid,this%nx) + 1 ny0 = myid/this%nx + 1 color = nx0 call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%ycomm,status) + _VERIFY(status) color = ny0 call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%xcomm,status) + _VERIFY(status) ny_by_writers = local_ny/this%num_writers @@ -270,15 +281,18 @@ subroutine create_communicators(this) color = MPI_UNDEFINED end if call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid,this%writers_comm,status) + _VERIFY(status) if (this%num_writers == local_ny) then this%gather_comm = this%xcomm else j = ny0 - mod(ny0-1,ny_by_writers) - call MPI_COMM_SPLIT(MPI_COMM_WORLD,j,myid,this%gather_comm,status) + call MPI_COMM_SPLIT(MPI_COMM_WORLD,j,myid,this%gather_comm, status) + _VERIFY(status) end if - call MPI_BARRIER(mpi_comm_world,status) + call MPI_BARRIER(mpi_comm_world, status) + _VERIFY(status) end subroutine @@ -286,7 +300,7 @@ subroutine create_communicators(this) subroutine close_file(this) class(test_support), intent(inout) :: this - integer :: status + integer :: status, rc integer(kind=INT64) :: sub_start,sub_end @@ -299,7 +313,8 @@ subroutine close_file(this) close(this%ncid) end if end if - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=sub_end) this%close_file_time = sub_end-sub_start end subroutine @@ -307,7 +322,7 @@ subroutine close_file(this) subroutine create_file(this) class(test_support), intent(inout) :: this - integer :: status + integer :: status, rc integer :: info integer :: xdim,ydim,zdim,i,varid,create_mode character(len=:), allocatable :: fname @@ -322,16 +337,22 @@ subroutine create_file(this) create_mode = IOR(create_mode,NF90_NETCDF4) create_mode = IOR(create_mode,NF90_SHARE) create_mode = IOR(create_mode,NF90_MPIIO) - call MPI_INFO_CREATE(info,status) - call MPI_INFO_SET(info,"cb_buffer_size","16777216",status) - call MPI_INFO_SET(info,"romio_cb_write","enable",status) + call MPI_INFO_CREATE(info, status) + _VERIFY(status) + call MPI_INFO_SET(info,"cb_buffer_size","16777216", status) + _VERIFY(status) + call MPI_INFO_SET(info,"romio_cb_write","enable", status) + _VERIFY(status) if (this%extra_info) then - call MPI_INFO_SET(info,"IBM_largeblock_io","true",status) - call MPI_INFO_SET(info,"striping_unit","4194304",status) + call MPI_INFO_SET(info,"IBM_largeblock_io","true", status) + _VERIFY(status) + call MPI_INFO_SET(info,"striping_unit","4194304", status) + _VERIFY(status) end if if (this%writers_comm /= MPI_COMM_NULL) then if (this%split_file) then - call MPI_COMM_RANK(this%writers_comm,writer_rank,status) + call MPI_COMM_RANK(this%writers_comm,writer_rank, status) + _VERIFY(status) write(fc,'(I0.3)')writer_rank fname = "checkpoint_"//fc//".nc4" status = nf90_create(fname,ior(NF90_NETCDF4,NF90_CLOBBER), this%ncid) @@ -368,14 +389,16 @@ subroutine create_file(this) else if (this%writers_comm /= MPI_COMM_NULL) then if (this%split_file) then - call MPI_COMM_RANK(this%writers_comm,writer_rank,status) + call MPI_COMM_RANK(this%writers_comm,writer_rank, status) + _VERIFY(status) write(fc,'(I0.3)')writer_rank fname = "checkpoint_"//fc//".bin" open(file=fname,newunit=this%ncid,status='replace',form='unformatted',access='sequential') end if end if end if - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=sub_end) this%create_file_time = sub_end-sub_start end subroutine @@ -383,13 +406,15 @@ subroutine create_file(this) subroutine write_file(this) class(test_support), intent(inout) :: this - integer :: status,i,l + integer :: status,i,l,rc integer(kind=INT64) :: sub_start,sub_end - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=sub_start) - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) do i=1,this%num_arrays if (this%gather_3d) then call this%write_variable(this%bundle(i)%field_name,this%bundle(i)%field) @@ -399,18 +424,21 @@ subroutine write_file(this) enddo end if enddo - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=sub_end) - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) this%write_3d_time = sub_end-sub_start - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) end subroutine subroutine write_variable(this,var_name,local_var) class(test_support), intent(inout) :: this character(len=*), intent(in) :: var_name real, intent(in) :: local_var(:,:,:) - integer :: status + integer :: status,rc real, allocatable :: recvbuf(:) integer :: I,J,N,K,L,myrow,myiorank,ndes_x integer :: start(3), cnt(3) @@ -427,9 +455,12 @@ subroutine write_variable(this,var_name,local_var) jm_world = this%im_world*6 ndes_x = size(this%in) - call mpi_comm_rank(this%ycomm,myrow,status) - call mpi_comm_rank(this%gather_comm,myiorank,status) - call mpi_comm_size(this%gather_comm,num_io_rows,status) + call mpi_comm_rank(this%ycomm,myrow, status) + _VERIFY(status) + call mpi_comm_rank(this%gather_comm,myiorank, status) + _VERIFY(status) + call mpi_comm_size(this%gather_comm,num_io_rows, status) + _VERIFY(status) num_io_rows=num_io_rows/ndes_x allocate (recvcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) @@ -461,7 +492,10 @@ subroutine write_variable(this,var_name,local_var) 0, this%gather_comm, status ) call system_clock(count=end_mpi) this%time_mpi = this%mpi_time + (end_mpi - start_mpi) - if (this%write_barrier) call MPI_Barrier(MPI_COMM_WORLD,status) + if (this%write_barrier) then + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + endif if(myiorank==0) then @@ -523,7 +557,7 @@ subroutine write_level(this,var_name,local_var,z_index) character(len=*), intent(in) :: var_name real, intent(in) :: local_var(:,:) integer, intent(in) :: z_index - integer :: status + integer :: status, rc real, allocatable :: recvbuf(:) integer :: I,J,N,K,L,myrow,myiorank,ndes_x integer :: start(3), cnt(3) @@ -540,9 +574,12 @@ subroutine write_level(this,var_name,local_var,z_index) jm_world = this%im_world*6 ndes_x = size(this%in) - call mpi_comm_rank(this%ycomm,myrow,status) - call mpi_comm_rank(this%gather_comm,myiorank,status) - call mpi_comm_size(this%gather_comm,num_io_rows,status) + call mpi_comm_rank(this%ycomm,myrow, status) + _VERIFY(status) + call mpi_comm_rank(this%gather_comm,myiorank, status) + _VERIFY(status) + call mpi_comm_size(this%gather_comm,num_io_rows, status) + _VERIFY(status) num_io_rows=num_io_rows/ndes_x allocate (recvcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) @@ -574,7 +611,10 @@ subroutine write_level(this,var_name,local_var,z_index) 0, this%gather_comm, status ) call system_clock(count=end_mpi) this%mpi_time = this%mpi_time + (end_mpi - start_mpi) - if (this%write_barrier) call MPI_Barrier(MPI_COMM_WORLD,status) + if (this%write_barrier) then + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + endif if(myiorank==0) then @@ -631,16 +671,18 @@ subroutine write_level(this,var_name,local_var,z_index) end module +#define I_AM_MAIN #include "MAPL_ErrLog.h" program checkpoint_tester use ESMF + use MAPL_ErrorHandlingMod + use mapl_checkpoint_support_mod use MPI use NetCDF - use mapl_checkpoint_support_mod use, intrinsic :: iso_fortran_env, only: REAL64, INT64 implicit NONE - integer :: status,rank,writer_size,writer_rank,comm_size,i + integer :: status,rank,writer_size,writer_rank,comm_size,i,rc type(test_support) :: support integer(kind=INT64) :: start_write,end_time,count_rate,start_app,end_app real(kind=REAL64) :: time_sum,write_time,create_time,close_time,write_3d_time,write_2d_time @@ -652,21 +694,29 @@ program checkpoint_tester call system_clock(count=start_app,count_rate=count_rate) call MPI_Init(status) + _VERIFY(status) call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) + _VERIFY(status) call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + _VERIFY(status) call ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE,mpiCommunicator=MPI_COMM_WORLD) call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) call support%set_parameters("checkpoint_benchmark.rc") call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) call support%create_arrays() call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) call support%create_communicators() call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) allocate(total_throughput(support%n_trials)) allocate(all_proc_throughput(support%n_trials)) @@ -675,15 +725,19 @@ program checkpoint_tester call support%reset() call system_clock(count=start_write) - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) if (support%do_writes) call support%create_file() - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) call support%write_file() - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) if (support%do_writes) call support%close_file() - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=end_time) write_time = real(end_time-start_write,kind=REAL64)/real(count_rate,kind=REAL64) @@ -694,11 +748,15 @@ program checkpoint_tester application_time = real(end_time - start_app,kind=REAL64)/real(count_rate,kind=REAL64) if (support%write_counter > 0) then - call MPI_COMM_SIZE(support%writers_comm,writer_size,status) - call MPI_COMM_RANK(support%writers_comm,writer_rank,status) - call MPI_AllReduce(support%data_volume,average_volume,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm,status) + call MPI_COMM_SIZE(support%writers_comm,writer_size, status) + _VERIFY(status) + call MPI_COMM_RANK(support%writers_comm,writer_rank, status) + _VERIFY(status) + call MPI_AllReduce(support%data_volume,average_volume,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm, status) + _VERIFY(status) average_volume = average_volume/real(writer_size,kind=REAL64) - call MPI_AllReduce(support%time_writing,average_time,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm,status) + call MPI_AllReduce(support%time_writing,average_time,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm, status) + _VERIFY(status) average_time = average_time/real(writer_size,kind=REAL64) end if if (rank == 0) then diff --git a/benchmarks/io/combo/CMakeLists.txt b/benchmarks/io/combo/CMakeLists.txt index 99a92e1b46a6..98b096a9515c 100644 --- a/benchmarks/io/combo/CMakeLists.txt +++ b/benchmarks/io/combo/CMakeLists.txt @@ -6,11 +6,6 @@ ecbuild_add_executable ( SOURCES Kernel.F90 GathervKernel.F90 BW_Benchmark.F90 ComboSpec.F90 driver.F90 DEFINITIONS USE_MPI) -target_link_libraries (${exe} PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse) +target_link_libraries (${exe} PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse OpenMP::OpenMP_Fortran) target_include_directories (${exe} PUBLIC $) set_target_properties (${exe} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${exe} PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/benchmarks/io/combo/GathervKernel.F90 b/benchmarks/io/combo/GathervKernel.F90 index 6ea74a11b6f8..4d2d358f9c51 100644 --- a/benchmarks/io/combo/GathervKernel.F90 +++ b/benchmarks/io/combo/GathervKernel.F90 @@ -48,8 +48,10 @@ subroutine init(this, rc) - call MPI_Comm_rank(this%comm, this%rank, _IERROR) - call MPI_Comm_size(this%comm, this%np, _IERROR) + call MPI_Comm_rank(this%comm, this%rank, status) + _VERIFY(status) + call MPI_Comm_size(this%comm, this%np, status) + _VERIFY(status) associate (np => this%np, n => this%n) allocate(this%buffer(this%n)) diff --git a/benchmarks/io/combo/driver.F90 b/benchmarks/io/combo/driver.F90 index 4ea28ed24704..329ddbe0a146 100644 --- a/benchmarks/io/combo/driver.F90 +++ b/benchmarks/io/combo/driver.F90 @@ -12,13 +12,15 @@ program main type(ComboSpec) :: spec integer :: status - call mpi_init(_IERROR) + call mpi_init(status) + _VERIFY(status) spec = make_ComboSpec() ! CLI call run(spec, _RC) - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) - call mpi_finalize(_IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + call mpi_finalize(status) stop @@ -47,14 +49,19 @@ subroutine run(spec, rc) real :: ta, tb integer :: color, rank, npes - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, status) + _VERIFY(status) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) color = (rank*spec%n_writers) / npes - call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, _IERROR) + call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, status) + _VERIFY(status) - call MPI_Comm_rank(gather_comm, rank, _IERROR) - call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, _IERROR) + call MPI_Comm_rank(gather_comm, rank, status) + _VERIFY(status) + call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, status) + _VERIFY(status) if (rank /= 0) then writer_comm = MPI_COMM_NULL end if @@ -99,10 +106,12 @@ real function time(kernel, comm, rc) integer :: status real :: t0, t1 - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) t0 = MPI_Wtime() call kernel%run(_RC) - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) t1 = MPI_Wtime() time = t1 - t0 @@ -117,7 +126,8 @@ subroutine write_header(comm, rc) integer :: status integer :: rank - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) write(*,'(4(a6,","),4(a15,:,","))',iostat=status) 'NX', '# levs', '# writers', 'group size', 'Time (s)', 'G Time (s)', 'W Time (s)', 'BW (GB/sec)' @@ -142,10 +152,12 @@ subroutine report(spec, avg_time, avg_time_gather, avg_time_write, comm, rc) real :: bw_gb integer, parameter :: WORD=4 - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) group = npes /spec%n_writers bw_gb = 1.e-9 * WORD * (spec%nx**2)*6*spec%n_levs / avg_time diff --git a/benchmarks/io/gatherv/CMakeLists.txt b/benchmarks/io/gatherv/CMakeLists.txt index d6072fb82823..8e053a91ca34 100644 --- a/benchmarks/io/gatherv/CMakeLists.txt +++ b/benchmarks/io/gatherv/CMakeLists.txt @@ -5,11 +5,6 @@ ecbuild_add_executable ( SOURCES GathervKernel.F90 GathervSpec.F90 driver.F90 DEFINITIONS USE_MPI) -target_link_libraries (gatherv.x PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse) +target_link_libraries (gatherv.x PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse OpenMP::OpenMP_Fortran) target_include_directories (gatherv.x PUBLIC $) set_target_properties (gatherv.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(gatherv.x PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/benchmarks/io/gatherv/GathervKernel.F90 b/benchmarks/io/gatherv/GathervKernel.F90 index d2e14c79293c..5a367ae1e177 100644 --- a/benchmarks/io/gatherv/GathervKernel.F90 +++ b/benchmarks/io/gatherv/GathervKernel.F90 @@ -47,8 +47,10 @@ subroutine init(this, rc) - call MPI_Comm_rank(this%comm, this%rank, _IERROR) - call MPI_Comm_size(this%comm, this%np, _IERROR) + call MPI_Comm_rank(this%comm, this%rank, status) + _VERIFY(status) + call MPI_Comm_size(this%comm, this%np, status) + _VERIFY(status) associate (np => this%np, n => this%n) allocate(this%buffer(this%n)) diff --git a/benchmarks/io/gatherv/GathervSpec.F90 b/benchmarks/io/gatherv/GathervSpec.F90 index 1841800f9b3b..5ddc8badebbe 100644 --- a/benchmarks/io/gatherv/GathervSpec.F90 +++ b/benchmarks/io/gatherv/GathervSpec.F90 @@ -95,7 +95,8 @@ function make_GathervKernel(spec, comm, rc) result(kernel) integer :: npes integer :: n - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) n = int(spec%nx,kind=INT64)**2 * 6 * spec%n_levs / npes kernel = GathervKernel(n, comm) diff --git a/benchmarks/io/gatherv/driver.F90 b/benchmarks/io/gatherv/driver.F90 index 743da8ea316a..505860369119 100644 --- a/benchmarks/io/gatherv/driver.F90 +++ b/benchmarks/io/gatherv/driver.F90 @@ -10,13 +10,15 @@ program main type(GathervSpec) :: spec integer :: status - call mpi_init(_IERROR) + call mpi_init(status) + _VERIFY(status) spec = make_GathervSpec() ! CLI call run(spec, _RC) - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) - call mpi_finalize(_IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + call mpi_finalize(status) stop @@ -42,14 +44,19 @@ subroutine run(spec, rc) real :: t integer :: color, rank, npes - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, status) + _VERIFY(status) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) color = (rank*spec%n_writers) / npes - call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, _IERROR) + call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, status) + _VERIFY(status) - call MPI_Comm_rank(gather_comm, rank, _IERROR) - call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, _IERROR) + call MPI_Comm_rank(gather_comm, rank, status) + _VERIFY(status) + call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, status) + _VERIFY(status) kernel = make_GathervKernel(spec, gather_comm, _RC) @@ -85,10 +92,12 @@ real function time(kernel, comm, rc) integer :: status real :: t0, t1 - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) t0 = MPI_Wtime() call kernel%run(_RC) - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) t1 = MPI_Wtime() time = t1 - t0 @@ -103,7 +112,8 @@ subroutine write_header(comm, rc) integer :: status integer :: rank - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) write(*,'(4(a6,","),3(a15,:,","))',iostat=status) 'NX', '# levs', '# writers', 'group size', 'Time (s)', 'Rel. Std. dev.', 'BW (GB/sec)' @@ -126,10 +136,12 @@ subroutine report(spec, avg_time, rel_std_time, comm, rc) real :: bw_gb integer, parameter :: WORD=4 - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) group = npes /spec%n_writers bw_gb = 1.e-9 * WORD * (spec%nx**2)*6*spec%n_levs / avg_time diff --git a/benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 b/benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 index a956e77f521b..6e8f2ede0cc0 100644 --- a/benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 +++ b/benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 @@ -99,7 +99,8 @@ function make_BW_Benchmark(spec, comm, rc) result(benchmark) call random_number(benchmark%buffer) end associate - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) benchmark%filename = make_filename(base='scratch.', rank=rank, width=5, _RC) _RETURN(_SUCCESS) diff --git a/benchmarks/io/raw_bw/CMakeLists.txt b/benchmarks/io/raw_bw/CMakeLists.txt index 7477ddf6e43f..e27428b2ea1e 100644 --- a/benchmarks/io/raw_bw/CMakeLists.txt +++ b/benchmarks/io/raw_bw/CMakeLists.txt @@ -5,11 +5,6 @@ ecbuild_add_executable ( SOURCES BW_Benchmark.F90 BW_BenchmarkSpec.F90 driver.F90 DEFINITIONS USE_MPI) -target_link_libraries (raw_bw.x PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse) +target_link_libraries (raw_bw.x PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse OpenMP::OpenMP_Fortran) target_include_directories (raw_bw.x PUBLIC $) set_target_properties (raw_bw.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(raw_bw.x PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/benchmarks/io/raw_bw/driver.F90 b/benchmarks/io/raw_bw/driver.F90 index 1af1aaa68867..804683316599 100644 --- a/benchmarks/io/raw_bw/driver.F90 +++ b/benchmarks/io/raw_bw/driver.F90 @@ -11,13 +11,15 @@ program main type(BW_BenchmarkSpec) :: spec integer :: status - call mpi_init(_IERROR) + call mpi_init(status) + _VERIFY(status) spec = make_BW_BenchmarkSpec() ! CLI call run(spec, _RC) - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) - call mpi_finalize(_IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + call mpi_finalize(status) stop @@ -43,14 +45,19 @@ subroutine run(spec, rc) real :: t integer :: color, rank, npes - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, status) + _VERIFY(status) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) color = (rank*spec%n_writers) / npes - call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, _IERROR) + call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, status) + _VERIFY(status) - call MPI_Comm_rank(gather_comm, rank, _IERROR) - call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, _IERROR) + call MPI_Comm_rank(gather_comm, rank, status) + _VERIFY(status) + call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, status) + _VERIFY(status) if (rank /= 0) writer_comm = MPI_COMM_NULL _RETURN_IF(writer_comm == MPI_COMM_NULL) @@ -89,11 +96,13 @@ real function time(benchmark, comm, rc) integer :: rank integer(kind=INT64) :: c0, c1, count_rate - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) call system_clock(c0) call benchmark%run(_RC) - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) call system_clock(c1, count_rate=count_rate) time = real(c1-c0)/count_rate @@ -109,7 +118,8 @@ subroutine write_header(comm, rc) integer :: status integer :: rank - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) write(*,'(3(a10,","),6(a15,:,","))',iostat=status) & @@ -136,8 +146,10 @@ subroutine report(spec, avg_time, std_time, comm, rc) integer, parameter :: WORD_SIZE = 4 integer(kind=INT64) :: packet_size - call MPI_Comm_size(comm, npes, _IERROR) - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_size(comm, npes, status) + _VERIFY(status) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) packet_size = int(spec%nx,kind=INT64)**2 * 6 * spec%n_levs / spec%n_writers @@ -145,7 +157,8 @@ subroutine report(spec, avg_time, std_time, comm, rc) total_gb = packet_gb * npes bw = total_gb / avg_time - call MPI_Comm_size(comm, npes, _IERROR) + call MPI_Comm_size(comm, npes, status) + _VERIFY(status) write(*,'(3(1x,i9.0,","),6(f15.4,:,","))') & spec%nx, spec%n_levs, spec%n_writers, & diff --git a/benchmarks/io/restart_simulator/CMakeLists.txt b/benchmarks/io/restart_simulator/CMakeLists.txt new file mode 100644 index 000000000000..be380f0d165a --- /dev/null +++ b/benchmarks/io/restart_simulator/CMakeLists.txt @@ -0,0 +1,16 @@ +set(exe restart_simulator.x) +set(MODULE_DIRECTORY ${esma_include}/benchmarks/io/restart_simulator) + +ecbuild_add_executable ( + TARGET ${exe} + SOURCES restart_simulator.F90 + DEFINITIONS USE_MPI) + +target_link_libraries (${exe} PRIVATE MAPL.shared MAPL.base MPI::MPI_Fortran FARGPARSE::fargparse ESMF::ESMF ) +target_include_directories (${exe} PUBLIC $) +set_target_properties (${exe} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + +# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 +if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") + target_link_libraries(${exe} PRIVATE OpenMP::OpenMP_Fortran) +endif () diff --git a/benchmarks/io/restart_simulator/README.md b/benchmarks/io/restart_simulator/README.md new file mode 100644 index 000000000000..3152425b0575 --- /dev/null +++ b/benchmarks/io/restart_simulator/README.md @@ -0,0 +1,19 @@ +This benchmark simulates writing a series of 3D variables of a given cubed-sphere resolution to a file using the same strategies as used by the real checkpoint code in MAPL + +The code has the following options and needs an ESMF rc file named checkpoint\_benchmark.rc + +- "NX:" the x distribution for each face +- "NY:" the y distribution for each face +- "IM\_WORLD:" the cube resolution +- "LM:" the nubmer of levels +- "NUM\_WRITERS:" the number of writing processes either to a single or independent files +- "NUM\_ARRAYS:" the number of 3D variables to write to the file +- "CHUNK:" whether to chunk, default true +- "SCATTER\_3D:" gather all levels at once (default is false which means a level at a time is gathered) +- "SPLIT\_FILE:" default false, if true, each writer writes to and independent file +- "WRITE\_BARRIER:" default false, add a barrier before each write to for synchronization +- "DO\_WRITES:" default true, if false skips writing (so just an mpi test at that point) +- "NTRIAL:" default 1, the number of trials to make writing +- "RANDOM\_DATA:" default true, if true will arrays with random data, if false sets the array to the rank of the process + +Note that whatever you set NX and NY to the program must be run on 6*NY*NY processors and the number of writers must evenly divide 6*NY diff --git a/benchmarks/io/restart_simulator/restart_simulator.F90 b/benchmarks/io/restart_simulator/restart_simulator.F90 new file mode 100644 index 000000000000..235cba280b5b --- /dev/null +++ b/benchmarks/io/restart_simulator/restart_simulator.F90 @@ -0,0 +1,716 @@ +#include "MAPL_ErrLog.h" +module mapl_restart_support_mod + + use ESMF + use MPI + use NetCDF + use MAPL_ErrorHandlingMod + use MAPL_MemUtilsMod + use, intrinsic :: iso_fortran_env, only: INT64, REAL64, REAL32 + implicit none + + real(kind=REAL64), parameter :: byte_to_mega = (1.0d0/1024.0d0)*(1.0d0/1024.0d0) + type array_wrapper + character(len=:), allocatable :: field_name + real, allocatable :: field(:,:,:) + end type + + type test_support + integer :: nx,ny,im_world,lm,num_arrays,num_readers,my_rank + integer :: scatter_comm + integer :: readers_comm + integer :: xcomm + integer :: ycomm + integer :: ncid + integer, allocatable :: i1(:),in(:),j1(:),jn(:) + type(array_wrapper), allocatable :: bundle(:) + integer :: face_index + integer(kind=INT64) :: read_counter + logical :: scatter_3d + logical :: split_file + logical :: extra_info + logical :: read_barrier + logical :: do_reads + real(kind=REAL64) :: data_volume + real(kind=REAL64) :: time_reading + real(kind=REAL64) :: time_mpi + logical :: netcdf_reads + integer :: n_trials + logical :: random + + integer(kind=INT64) :: mpi_time + integer(kind=INT64) :: read_3d_time + integer(kind=INT64) :: read_2d_time + integer(kind=INT64) :: open_file_time + integer(kind=INT64) :: close_file_time + contains + procedure :: set_parameters + procedure :: compute_decomposition + procedure :: allocate_n_arrays + procedure :: create_arrays + procedure :: create_communicators + procedure :: open_file + procedure :: close_file + procedure :: read_file + procedure :: read_level + procedure :: read_variable + procedure :: reset + end type + +contains + + subroutine set_parameters(this,config_file) + class(test_support), intent(inout) :: this + character(len=*), intent(in) :: config_file + type(ESMF_Config) :: config + + integer :: comm_size, status,error_code + + config = ESMF_ConfigCreate() + this%extra_info = .false. + this%read_barrier = .false. + this%do_reads = .true. + call ESMF_ConfigLoadFile(config,config_file) + call ESMF_ConfigGetAttribute(config,this%nx,label="NX:") + call ESMF_ConfigGetAttribute(config,this%ny,label="NY:") + call ESMF_ConfigGetAttribute(config,this%im_world,label="IM_WORLD:") + call ESMF_ConfigGetAttribute(config,this%lm,label="LM:") + call ESMF_ConfigGetAttribute(config,this%num_readers,label="NUM_READERS") + call ESMF_ConfigGetAttribute(config,this%num_arrays,label="NUM_ARRAYS:") + this%scatter_3d = get_logical_key(config,"SCATTER_3D:",.false.) + this%split_file = get_logical_key(config,"SPLIT_FILE:",.false.) + this%extra_info = get_logical_key(config,"EXTRA_INFO:",.false.) + this%read_barrier = get_logical_key(config,"read_BARRIER:",.false.) + this%do_reads = get_logical_key(config,"DO_READS:",.true.) + this%netcdf_reads = get_logical_key(config,"netcdf_reads:",.true.) + this%n_trials = get_integer_key(config,"NTRIALS:",1) + this%random = get_logical_key(config,"RANDOM_DATA:",.true.) + + this%read_counter = 0 + this%read_3d_time = 0 + this%read_2d_time = 0 + this%open_file_time = 0 + this%close_file_time = 0 + this%data_volume = 0.d0 + this%time_reading = 0.d0 + this%mpi_time = 0.0 + call MPI_COMM_SIZE(MPI_COMM_WORLD,comm_size,status) + if (comm_size /= (this%nx*this%ny*6)) call MPI_Abort(mpi_comm_world,error_code,status) + + contains + + function get_logical_key(config,label,default_val) result(val) + logical :: val + type(ESMF_Config), intent(Inout) :: config + character(len=*), intent(in) :: label + logical, intent(in) :: default_val + + logical :: is_present + call ESMF_ConfigFindlabel(config,label,isPresent=is_present) + if (is_present) then + call ESMF_ConfigGetAttribute(config,val,label=label) + else + val = default_val + end if + end function + + function get_integer_key(config,label,default_val) result(val) + integer :: val + type(ESMF_Config), intent(Inout) :: config + character(len=*), intent(in) :: label + integer, intent(in) :: default_val + + logical :: is_present + call ESMF_ConfigFindlabel(config,label,isPresent=is_present) + if (is_present) then + call ESMF_ConfigGetAttribute(config,val,label=label) + else + val = default_val + end if + end function + + end subroutine + + subroutine reset(this) + class(test_support), intent(inout) :: this + this%read_counter = 0 + this%read_3d_time = 0 + this%read_2d_time = 0 + this%open_file_time = 0 + this%close_file_time = 0 + this%data_volume = 0.d0 + this%time_reading = 0.d0 + this%mpi_time = 0.0 + end subroutine + + function compute_decomposition(this,axis) result(decomp) + integer, allocatable :: decomp(:) + class(test_support), intent(inout) :: this + integer, intent(in) :: axis + + integer :: n_loc, rm, im, n + + if (axis == 1) then + n_loc = this%nx + else if (axis ==2) then + n_loc = this%ny + end if + allocate(decomp(n_loc)) + im = this%im_world/n_loc + rm = this%im_world-n_loc*im + do n = 1,n_loc + decomp(n) = im + if (n.le.rm) decomp(n) = im+1 + enddo + + end function + + subroutine allocate_n_arrays(this,im,jm) + class(test_support), intent(inout) :: this + integer, intent(in) :: im + integer, intent(in) :: jm + + integer :: n,rank,status + character(len=3) :: formatted_int + integer :: seed_size + integer, allocatable :: seeds(:) + + call MPI_COMM_RANK(MPI_COMM_WORLD,rank,status) + call random_seed(size=seed_size) + allocate(seeds(seed_size)) + seeds = rank + call random_seed(put=seeds) + do n=1,size(this%bundle) + write(formatted_int,'(i0.3)')n + this%bundle(n)%field_name = "VAR"//formatted_int + allocate(this%bundle(n)%field(im,jm,this%lm)) + if (this%random) then + call random_number(this%bundle(n)%field) + else + this%bundle(n)%field = rank + end if + enddo + end subroutine + + subroutine create_arrays(this) + class(test_support), intent(inout) :: this + + integer, allocatable :: ims(:),jms(:) + integer :: rank, status,comm_size,n,i,j,rank_counter,offset,index_offset + + call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) + call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + allocate(this%bundle(this%num_arrays)) + ims = this%compute_decomposition(axis=1) + jms = this%compute_decomposition(axis=2) + allocate(this%i1(this%nx)) + allocate(this%in(this%nx)) + allocate(this%j1(this%ny*6)) + allocate(this%jn(this%ny*6)) + rank_counter = 0 + this%i1(1)=1 + this%j1(1)=1 + this%in(1)=ims(1) + this%jn(1)=jms(1) + + do i=2,this%nx + this%i1(i) = this%in(i-1)+1 + this%in(i) = this%in(i-1)+ims(i) + enddo + + do j=2,this%ny + this%j1(j) = this%jn(j-1)+1 + this%jn(j) = this%jn(j-1)+jms(j) + enddo + + do n=2,6 + index_offset = (n-1)*this%ny + offset = (n-1)*this%im_world + do j=1,this%ny + this%j1(j+index_offset)=this%j1(j) + offset + this%jn(j+index_offset)=this%jn(j) + offset + enddo + enddo + + do n=1,6 + do j=1,this%ny + do i=1,this%nx + if (rank == rank_counter) then + call this%allocate_n_arrays(ims(i),jms(j)) + end if + rank_counter = rank_counter + 1 + enddo + enddo + enddo + + end subroutine + + subroutine create_communicators(this) + class(test_support), intent(inout) :: this + + integer :: myid,status,nx0,ny0,color,j,ny_by_readers,local_ny + + local_ny = this%ny*6 + call MPI_Comm_Rank(mpi_comm_world,myid,status) + nx0 = mod(myid,this%nx) + 1 + ny0 = myid/this%nx + 1 + color = nx0 + call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%ycomm,status) + color = ny0 + call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%xcomm,status) + + + ny_by_readers = local_ny/this%num_readers + if (mod(myid,(this%nx*local_ny)/this%num_readers) == 0) then + color = 0 + else + color = MPI_UNDEFINED + end if + call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid,this%readers_comm,status) + + if (this%num_readers == local_ny) then + this%scatter_comm = this%xcomm + else + j = ny0 - mod(ny0-1,ny_by_readers) + call MPI_COMM_SPLIT(MPI_COMM_WORLD,j,myid,this%scatter_comm,status) + end if + + call MPI_BARRIER(mpi_comm_world,status) + + + end subroutine + + subroutine close_file(this) + class(test_support), intent(inout) :: this + + integer :: status + + integer(kind=INT64) :: sub_start,sub_end + + call system_clock(count=sub_start) + + if (this%readers_comm /= MPI_COMM_NULL) then + if (this%netcdf_reads) then + status = nf90_close(this%ncid) + else + close(this%ncid) + end if + end if + call MPI_BARRIER(MPI_COMM_WORLD,status) + call system_clock(count=sub_end) + this%close_file_time = sub_end-sub_start + end subroutine + + subroutine open_file(this) + class(test_support), intent(inout) :: this + + integer :: status, rc + integer :: info + integer :: xdim,ydim,zdim,i,varid,create_mode + character(len=:), allocatable :: fname + character(len=3) :: fc + integer(kind=INT64) :: sub_start,sub_end + integer :: writer_rank + + call system_clock(count=sub_start) + if (this%netcdf_reads) then + + create_mode = NF90_NOWRITE + create_mode = IOR(create_mode,NF90_SHARE) + create_mode = IOR(create_mode,NF90_MPIIO) + call MPI_INFO_CREATE(info,status) + call MPI_INFO_SET(info,"cb_buffer_size","16777216",status) + call MPI_INFO_SET(info,"romio_cb_write","enable",status) + if (this%extra_info) then + call MPI_INFO_SET(info,"IBM_largeblock_io","true",status) + call MPI_INFO_SET(info,"striping_unit","4194304",status) + end if + if (this%readers_comm /= MPI_COMM_NULL) then + if (this%split_file) then + call MPI_COMM_RANK(this%readers_comm,writer_rank,status) + write(fc,'(I0.3)')writer_rank + fname = "checkpoint_"//fc//".nc4" + status = nf90_open(fname,ior(NF90_NETCDF4,NF90_CLOBBER), this%ncid) + else + fname = "checkpoint.nc4" + status = nf90_open(fname,create_mode, this%ncid, comm=this%readers_comm, info=info) + end if + end if + else + if (this%readers_comm /= MPI_COMM_NULL) then + if (this%split_file) then + call MPI_COMM_RANK(this%readers_comm,writer_rank,status) + write(fc,'(I0.3)')writer_rank + fname = "checkpoint_"//fc//".bin" + open(file=fname,newunit=this%ncid,status='old',form='unformatted',access='sequential') + end if + end if + end if + call MPI_BARRIER(MPI_COMM_WORLD,status) + call system_clock(count=sub_end) + this%open_file_time = sub_end-sub_start + end subroutine + + + subroutine read_file(this) + class(test_support), intent(inout) :: this + integer :: status,i,l + + integer(kind=INT64) :: sub_start,sub_end + + call MPI_BARRIER(MPI_COMM_WORLD,status) + call system_clock(count=sub_start) + call MPI_BARRIER(MPI_COMM_WORLD,status) + do i=1,this%num_arrays + if (this%scatter_3d) then + call this%read_variable(this%bundle(i)%field_name,this%bundle(i)%field) + else + do l = 1,this%lm + call this%read_level(this%bundle(i)%field_name,this%bundle(i)%field(:,:,l),l) + enddo + end if + enddo + call MPI_BARRIER(MPI_COMM_WORLD,status) + call system_clock(count=sub_end) + call MPI_BARRIER(MPI_COMM_WORLD,status) + this%read_3d_time = sub_end-sub_start + call MPI_BARRIER(MPI_COMM_WORLD,status) + end subroutine + + subroutine read_variable(this,var_name,local_var) + class(test_support), intent(inout) :: this + character(len=*), intent(in) :: var_name + real, intent(in) :: local_var(:,:,:) + integer :: status + real, allocatable :: buf(:) + integer :: I,J,N,K,L,myrow,myiorank,ndes_x + integer :: start(3), cnt(3) + integer :: jsize, jprev, num_io_rows + integer, allocatable :: sendcounts(:), displs(:) + integer :: im_world,jm_world,varid + real, allocatable :: var(:,:,:) + integer(kind=INT64) :: start_time,end_time,count_rate,lev,start_mpi,end_mpi + real(kind=REAL64) :: io_time + + call system_clock(count_rate=count_rate) + im_world = this%im_world + jm_world = this%im_world*6 + ndes_x = size(this%in) + + call mpi_comm_rank(this%ycomm,myrow,status) + call mpi_comm_rank(this%scatter_comm,myiorank,status) + call mpi_comm_size(this%scatter_comm,num_io_rows,status) + num_io_rows=num_io_rows/ndes_x + + allocate (sendcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) + + if(myiorank==0) then + do j=1,num_io_rows + jsize = this%jn(myrow+j) - this%j1(myrow+j) + 1 + sendcounts((j-1)*ndes_x+1:(j-1)*ndes_x+ndes_x) = ( this%IN - this%I1 + 1) * jsize * this%lm + enddo + + displs(1) = 0 + do i=2,ndes_x*num_io_rows + displs(i) = displs(i-1) + sendcounts(i-1) + enddo + + jsize = 0 + do j=1,num_io_rows + jsize=jsize + (this%jn(myrow+j) - this%j1(myrow+j) + 1) + enddo + allocate(VAR(IM_WORLD,jsize,this%lm), stat=status) + allocate(buf(IM_WORLD*jsize*this%lm), stat=status) + + start(1) = 1 + if (this%split_file) then + start(2) = 1 + else + start(2) = this%j1(myrow+1) + end if + start(3)= 1 + cnt(1) = IM_WORLD + cnt(2) = jsize + cnt(3) = this%lm + + call system_clock(count=start_time) + if (this%do_reads) then + if (this%netcdf_reads) then + status = nf90_inq_varid(this%ncid,name=var_name ,varid=varid) + status = nf90_get_var(this%ncid,varid,var,start,cnt) + else + write(this%ncid)var + end if + else + var=this%my_rank + end if + call system_clock(count=end_time) + this%read_counter = this%read_counter + 1 + io_time = end_time-start_time + this%data_volume = this%data_volume+byte_to_mega*4.d0*size(var,kind=INT64) + this%time_reading = this%time_reading + real(io_time,kind=REAL64)/real(count_rate,kind=REAL64) + + jprev = 0 + k=1 + do l=1,num_io_rows + jsize = this%jn(myrow+l) - this%j1(myrow+l) + 1 + do n=1,ndes_x + do lev =1,this%lm + do j=1,jsize + do i=this%i1(n),this%in(n) + buf(k) = VAR(i,jprev+j, lev) + k=k+1 + end do + end do + enddo + end do + jprev = jprev + jsize + end do + jsize=jprev + + deallocate(VAR, stat=status) + end if + + if(myiorank/=0) then + allocate(buf(0), stat=status) + endif + + call system_clock(count=start_mpi) + call mpi_scatterv( buf, sendcounts, displs, MPI_REAL, local_var, size(local_var), MPI_REAL, & + 0, this%scatter_comm, status ) + call system_clock(count=end_mpi) + this%time_mpi = this%mpi_time + (end_mpi - start_mpi) + if (this%read_barrier) call MPI_Barrier(MPI_COMM_WORLD,status) + + deallocate(buf, stat=status) + deallocate (sendcounts, displs, stat=status) + + end subroutine + + subroutine read_level(this,var_name,local_var,z_index) + class(test_support), intent(inout) :: this + character(len=*), intent(in) :: var_name + real, intent(in) :: local_var(:,:) + integer, intent(in) :: z_index + integer :: status + real, allocatable :: buf(:) + integer :: I,J,N,K,L,myrow,myiorank,ndes_x + integer :: start(3), cnt(3) + integer :: jsize, jprev, num_io_rows + integer, allocatable :: sendcounts(:), displs(:) + integer :: im_world,jm_world,varid + real, allocatable :: var(:,:) + integer(kind=INT64) :: start_time,end_time,count_rate,start_mpi,end_mpi + real(kind=REAL64) :: io_time + + call system_clock(count_rate=count_rate) + im_world = this%im_world + jm_world = this%im_world*6 + ndes_x = size(this%in) + + call mpi_comm_rank(this%ycomm,myrow,status) + call mpi_comm_rank(this%scatter_comm,myiorank,status) + call mpi_comm_size(this%scatter_comm,num_io_rows,status) + num_io_rows=num_io_rows/ndes_x + + allocate (sendcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) + + if(myiorank==0) then + do j=1,num_io_rows + jsize = this%jn(myrow+j) - this%j1(myrow+j) + 1 + sendcounts((j-1)*ndes_x+1:(j-1)*ndes_x+ndes_x) = ( this%IN - this%I1 + 1) * jsize + enddo + + displs(1) = 0 + do i=2,ndes_x*num_io_rows + displs(i) = displs(i-1) + sendcounts(i-1) + enddo + + jsize = 0 + do j=1,num_io_rows + jsize=jsize + (this%jn(myrow+j) - this%j1(myrow+j) + 1) + enddo + allocate(VAR(IM_WORLD,jsize), stat=status) + allocate(buf(IM_WORLD*jsize), stat=status) + + start(1) = 1 + if (this%split_file) then + start(2) = 1 + else + start(2) = this%j1(myrow+1) + end if + start(3)=z_index + cnt(1) = IM_WORLD + cnt(2) = jsize + cnt(3) = 1 + + call system_clock(count=start_time) + if (this%do_reads) then + if (this%netcdf_reads) then + status = nf90_inq_varid(this%ncid,name=var_name ,varid=varid) + status = nf90_get_var(this%ncid,varid,var,start,cnt) + else + read(this%ncid)var + end if + else + var=this%my_rank + end if + call system_clock(count=end_time) + this%read_counter = this%read_counter + 1 + io_time = end_time-start_time + this%data_volume = this%data_volume+byte_to_mega*4.d0*size(var,kind=INT64) + this%time_reading = this%time_reading + real(io_time,kind=REAL64)/real(count_rate,kind=REAL64) + + jprev = 0 + k=1 + do l=1,num_io_rows + jsize = this%jn(myrow+l) - this%j1(myrow+l) + 1 + do n=1,ndes_x + do j=1,jsize + do i=this%i1(n),this%in(n) + buf(k) = var(i,jprev+j) + k=k+1 + end do + end do + end do + jprev = jprev + jsize + end do + jsize=jprev + + + deallocate(VAR, stat=status) + end if + + if(myiorank/=0) then + allocate(buf(0), stat=status) + endif + + call system_clock(count=start_mpi) + call mpi_scatterv( buf, sendcounts, displs, MPI_REAL, local_var, size(local_var), MPI_REAL, & + 0, this%scatter_comm, status ) + call system_clock(count=end_mpi) + this%mpi_time = this%mpi_time + (end_mpi - start_mpi) + if (this%read_barrier) call MPI_Barrier(MPI_COMM_WORLD,status) + + deallocate(buf, stat=status) + deallocate (sendcounts, displs, stat=status) + + end subroutine + +end module + +#include "MAPL_ErrLog.h" +program checkpoint_tester + use ESMF + use MPI + use NetCDF + use mapl_restart_support_mod + use, intrinsic :: iso_fortran_env, only: REAL64, INT64 + implicit NONE + + integer :: status,rank,reader_size,reader_rank,comm_size,i + type(test_support) :: support + integer(kind=INT64) :: start_read,end_time,count_rate,start_app,end_app + real(kind=REAL64) :: time_sum,read_time,create_time,close_time,read_3d_time,read_2d_time + real(kind=REAL64) :: application_time,data_volume + real(kind=REAL64) :: average_volume,average_time + real(kind=REAL64), allocatable :: total_throughput(:), all_proc_throughput(:) + real(kind=REAL64) :: mean_throughput, mean_fs_throughput + real(kind=REAL64) :: std_throughput, std_fs_throughput + + call system_clock(count=start_app,count_rate=count_rate) + call MPI_Init(status) + call MPI_Barrier(MPI_COMM_WORLD,status) + + call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) + support%my_rank = rank + call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + call ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE,mpiCommunicator=MPI_COMM_WORLD) + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%set_parameters("restart_benchmark.rc") + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%create_arrays() + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%create_communicators() + call MPI_Barrier(MPI_COMM_WORLD,status) + + allocate(total_throughput(support%n_trials)) + allocate(all_proc_throughput(support%n_trials)) + do i=1,support%n_trials + if (rank == 0) write(*,*)"Trial ",i + call support%reset() + + call system_clock(count=start_read) + call MPI_Barrier(MPI_COMM_WORLD,status) + call support%open_file() + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%read_file() + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%close_file() + call MPI_Barrier(MPI_COMM_WORLD,status) + + call system_clock(count=end_time) + read_time = real(end_time-start_read,kind=REAL64)/real(count_rate,kind=REAL64) + create_time = real(support%open_file_time,kind=REAL64)/real(count_rate,kind=REAL64) + read_3d_time = real(support%read_3d_time,kind=REAL64)/real(count_rate,kind=REAL64) + close_time = real(support%close_file_time,kind=REAL64)/real(count_rate,kind=REAL64) + time_sum = create_time + read_3d_time + close_time + application_time = real(end_time - start_app,kind=REAL64)/real(count_rate,kind=REAL64) + + if (support%readers_comm /= MPI_COMM_NULL) then + call MPI_COMM_SIZE(support%readers_comm,reader_size,status) + call MPI_COMM_RANK(support%readers_comm,reader_rank,status) + call MPI_AllReduce(support%data_volume,average_volume,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%readers_comm,status) + average_volume = average_volume/real(reader_size,kind=REAL64) + call MPI_AllReduce(support%time_reading,average_time,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%readers_comm,status) + average_time = average_time/real(reader_size,kind=REAL64) + end if + if (rank == 0) then + total_throughput(i) = byte_to_mega*real(support%num_arrays,kind=REAL64)*real(support%im_world,kind=REAL64) & + *real(support%im_world,kind=REAL64)*6.d0*real(support%lm,kind=REAL64)*4.d0/read_3d_time + all_proc_throughput(i) = real(support%num_readers,kind=REAL32)*average_volume/average_time + end if + enddo + + call system_clock(count=end_app) + application_time = real(end_app - start_app,kind=REAL64)/real(count_rate,kind=REAL64) + if (rank == 0) then + data_volume = byte_to_mega*real(support%num_arrays,kind=REAL64)*real(support%im_world,kind=REAL64) & + *real(support%im_world,kind=REAL64)*6.d0*real(support%lm,kind=REAL64)*4.d0 + write(*,*)"***************************************************" + write(*,*)"Summary of run: " + write(*,'(A,G16.8)')"Total data volume in megabytes: ",data_volume + write(*,'(A,I3)')"Num readers: ",support%num_readers + write(*,'(A,I6)')"Total cores: ",comm_size + write(*,'(A,I6,I6)')"Cube size/LM: ",support%im_world,support%lm + write(*,'(A,6(L1))')"Split file, 3D_scatter, extra, netcdf output, write barrier, do writes: ",& + support%split_file, support%scatter_3d, & + support%extra_info, & + support%netcdf_reads,support%read_barrier, support%do_reads + write(*,'(A,I6)')"Number of trial: ",support%n_trials + write(*,'(A,G16.8)')"Application time: ",application_time + end if + + if (rank == 0) then + write(*,'(A)')"Real throughput MB/s, Std Real throughput MB/s, file system MB/S, std file system MB/s" + mean_throughput = sum(total_throughput)/real(support%n_trials,kind=REAL64) + mean_fs_throughput = sum(all_proc_throughput)/real(support%n_trials,kind=REAL64) + std_throughput = 0.d0 + std_fs_throughput = 0.d0 + do i=1,support%n_trials + std_throughput = std_throughput + (total_throughput(i)-mean_throughput)**2 + std_fs_throughput = std_fs_throughput + (all_proc_throughput(i)-mean_fs_throughput)**2 + enddo + std_throughput = sqrt(std_throughput/real(support%n_trials,kind=REAL64)) + std_fs_throughput = sqrt(std_fs_throughput/real(support%n_trials,kind=REAL64)) + write(*,'(G16.8,G16.8,G16.8,G16.8)')mean_throughput,std_throughput,mean_fs_throughput,std_fs_throughput + end if + + + call MPI_Finalize(status) +end program diff --git a/cmake/Findudunits.cmake b/cmake/Findudunits.cmake new file mode 100644 index 000000000000..4978694b91ac --- /dev/null +++ b/cmake/Findudunits.cmake @@ -0,0 +1,68 @@ +# (C) Copyright 2022- UCAR. +# +# Try to find the udunits headers and library +# +# This module defines: +# +# - udunits::udunits - The udunits shared library and include directory, all in a single target. +# - udunits_FOUND - True if udunits was found +# - udunits_INCLUDE_DIR - The include directory +# - udunits_LIBRARY - The library +# - udunits_LIBRARY_SHARED - Whether the library is shared or not +# - udunits_XML_PATH - path to udunits2.xml +# +# The following paths will be searched in order if set in CMake (first priority) or environment (second priority): +# +# - UDUNITS2_INCLUDE_DIRS & UDUNITS2_LIBRARIES - folders containing udunits2.h and libudunits2, respectively. +# - UDUNITS2_ROOT - root of udunits installation +# - UDUNITS2_PATH - root of udunits installation +# +# Notes: +# - The hint variables are capitalized because this is how they are exposed in the jedi stack. +# See https://github.com/JCSDA-internal/jedi-stack/blob/develop/modulefiles/compiler/compilerName/compilerVersion/udunits/udunits.lua for details. + +find_path ( + udunits_INCLUDE_DIR + udunits2.h + HINTS ${UDUNITS2_INCLUDE_DIRS} $ENV{UDUNITS2_INCLUDE_DIRS} + ${UDUNITS2_ROOT} $ENV{UDUNITS2_ROOT} + ${UDUNITS2_PATH} $ENV{UDUNITS2_PATH} + PATH_SUFFIXES include include/udunits2 + DOC "Path to udunits2.h" ) + +find_file ( + udunits_XML_PATH + udunits2.xml + HINTS ${UDUNITS2_XML_PATH} $ENV{UDUNITS2_XML_PATH} + ${UDUNITS2_ROOT} $ENV{UDUNITS2_ROOT} + ${UDUNITS2_PATH} $ENV{UDUNITS2_PATH} + PATH_SUFFIXES share share/udunits + DOC "Path to udunits2.xml" ) + +find_library(udunits_LIBRARY + NAMES udunits2 udunits + HINTS ${UDUNITS2_LIBRARIES} $ENV{UDUNITS2_LIBRARIES} + ${UDUNITS2_ROOT} $ENV{UDUNITS2_ROOT} + ${UDUNITS2_PATH} $ENV{UDUNITS2_PATH} + PATH_SUFFIXES lib64 lib + DOC "Path to libudunits library" ) + +# We need to support both static and shared libraries +if (udunits_LIBRARY MATCHES ".*\\.a$") + set(udunits_LIBRARY_SHARED FALSE) +else() + set(udunits_LIBRARY_SHARED TRUE) +endif() + +include (FindPackageHandleStandardArgs) +find_package_handle_standard_args (udunits DEFAULT_MSG udunits_LIBRARY udunits_INCLUDE_DIR udunits_XML_PATH) + +mark_as_advanced (udunits_LIBRARY udunits_INCLUDE_DIR udunits_XML_PATH) + +if(udunits_FOUND AND NOT TARGET udunits::udunits) + add_library(udunits::udunits INTERFACE IMPORTED) + set_target_properties(udunits::udunits PROPERTIES INTERFACE_INCLUDE_DIRECTORIES ${udunits_INCLUDE_DIR}) + set_target_properties(udunits::udunits PROPERTIES INTERFACE_LINK_LIBRARIES ${udunits_LIBRARY}) + set_property(TARGET udunits::udunits APPEND PROPERTY INTERFACE_LINK_LIBRARIES ${CMAKE_DL_LIBS}) +endif() + diff --git a/components.yaml b/components.yaml index bf46f2c95c5d..1796c1de157f 100644 --- a/components.yaml +++ b/components.yaml @@ -5,13 +5,13 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v4.29.0 + tag: v4.30.1 develop: main ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.46.0 + tag: v3.51.0 develop: develop ecbuild: diff --git a/docs/tutorial/driver_app/CMakeLists.txt b/docs/tutorial/driver_app/CMakeLists.txt index 8e758b5c0693..3d1c519863c2 100644 --- a/docs/tutorial/driver_app/CMakeLists.txt +++ b/docs/tutorial/driver_app/CMakeLists.txt @@ -3,9 +3,6 @@ set (srcs ) ecbuild_add_executable (TARGET Example_Driver.x SOURCES ${srcs}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(Example_Driver.x PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(Example_Driver.x PRIVATE MAPL) +target_link_libraries(Example_Driver.x PRIVATE MAPL OpenMP::OpenMP_Fortran) target_compile_definitions (Example_Driver.x PRIVATE $<$:BUILD_WITH_EXTDATA2G>) diff --git a/docs/tutorial/grid_comps/automatic_code_generator_example/CMakeLists.txt b/docs/tutorial/grid_comps/automatic_code_generator_example/CMakeLists.txt index 8422b3a79540..445d474d49a3 100644 --- a/docs/tutorial/grid_comps/automatic_code_generator_example/CMakeLists.txt +++ b/docs/tutorial/grid_comps/automatic_code_generator_example/CMakeLists.txt @@ -6,7 +6,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) @@ -15,7 +15,3 @@ set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${t mapl_acg (${this} ACG_StateSpecs.rc IMPORT_SPECS EXPORT_SPECS GET_POINTERS DECLARE_POINTERS) - -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/docs/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt b/docs/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt index 0e74c76742a1..a10133e784af 100644 --- a/docs/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt +++ b/docs/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt b/docs/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt index d912da16f28d..89c5fb82c524 100644 --- a/docs/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt +++ b/docs/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt b/docs/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt index e2ae84142283..520e3bfa0e22 100644 --- a/docs/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt +++ b/docs/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt b/docs/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt index c9c4299b76bd..3547b1d35434 100644 --- a/docs/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt +++ b/docs/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt b/docs/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt index b5da305f8e82..db03b5589754 100644 --- a/docs/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt +++ b/docs/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt b/docs/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt index 66b39a86a6b3..950f444f315b 100644 --- a/docs/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt +++ b/docs/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/mapl_tutorials/hello_world/README.md b/docs/tutorial/mapl_tutorials/hello_world/README.md index 59b1075b196d..1596af2c8c26 100644 --- a/docs/tutorial/mapl_tutorials/hello_world/README.md +++ b/docs/tutorial/mapl_tutorials/hello_world/README.md @@ -34,7 +34,7 @@ After this call MAPL_GenericInitialize is called. This is again a MAPL call that Finally we get to the run method my_run. Notice it has the same interface the initialize method. This was registered and will be executed each time step. As you can see if does very little in this example. It gets the current time from the ESMF clock (this literally a clock that is advanced by the MAPL "CAP"). The time is stored in a variable of `type(ESMF_Time)` declared in the subroutine. It then prints the obligatory "Hello World" and finally uses an ESMF cal which takes an ESMF time and prints it as a string. # A Note on Error Handling -You will notice that the setServices, initialize, and run subroutines all have an optional rc return variable. This is represents a return code that the calling routine can check to see if the subroutine executed successfully or produced an error. All ESMF and MAPL subroutines and functions have an optional rc value that can be checked when making a call. To check the return status you would do something like this. +You will notice that the setServices, initialize, and run subroutines all have an optional rc return variable. This is represents a return code that the calling routine can check to see if the subroutine executed successfully or produced an error. All ESMF and MAPL subroutines and functions have an optional rc value that can be checked when making a call. To check the return status you would do something like this. ``` integer :: status @@ -51,7 +51,7 @@ end This would get very tedious, not to mention make the code hard to read if the user had to do this after every subroutine or function call. To assist the developer MAPL defines a collection of preprocessor macros for error checking . -You will notice that all subroutine calls in this example end with `_RC`. This is a preprocessor macro that expands to `rc=status); _VERIFY(status`. +You will notice that all subroutine calls in this example end with `_RC`. This is a preprocessor macro that expands to `rc=status); _VERIFY(status`. `_VERIFY` itself is another macro that essentially implements the lines after the call to `ESMF_Foo` in the previous example. It will check the status and if there is an error report the file and line and return. @@ -74,7 +74,7 @@ srun: cluster configuration lacks support for cpu binding Integer*4 Resource Parameter: HEARTBEAT_DT:3600 NOT using buffer I/O for file: cap_restart CAP: Read CAP restart properly, Current Date = 2007/08/01 - CAP: Current Time = 00/00/00 + CAP: Current Time = 00:00:00 Character Resource Parameter: ROOT_CF:hello_world.rc Character Resource Parameter: ROOT_NAME:hello_world Character Resource Parameter: HIST_CF:HISTORY.rc @@ -107,14 +107,14 @@ end Time ------------------------------- AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 21061906.1 10684057.3 25508595.8 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used ``` - Lets see how this corresponds to what is in the input files. + Lets see how this corresponds to what is in the input files. First lets discuss the CAP.rc, the relevant lines are ``` JOB_SGMT: 00000001 000000 HEARTBEAT_DT: 3600 ``` -which tell the MAPL "CAP" to run 1 day via the JOB_SGMT line and with a timestep of 3600s. In addition the +which tell the MAPL "CAP" to run 1 day via the JOB_SGMT line and with a timestep of 3600s. In addition the ``` ROOT_CF: hello_world.rc ``` @@ -134,7 +134,7 @@ SHMEM: Total PEs = 1 ``` which says we are using 1 MPI task. Then later you the tell works and quick glance should confirm it is stepping the clock by 1 hour each time. Finally you see lines like this: -``` -AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 21061906.1 10684057.3 25508595.8 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used +``` +AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 21061906.1 10684057.3 25508595.8 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used ``` This is actually reported by the "CAP" itself. and prints the current time as well as some statistics about memroy use and throughput. The astute user will notice that the time reported here is 1 hour after the time printed in the gridded component. This is because the clock is advanced at the end of each iteration in the "CAP", after the component is run and this reporting is at the very end of each iteration. diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 06b6468771dc..05ecbe82cba4 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -22,7 +22,6 @@ set (srcs VarSpecPtr.F90 VarConnPoint.F90 VarConnType.F90 - VariableSpecification.F90 VarSpecMiscMod.F90 VarSpecVector.F90 VarConnPoint.F90 @@ -69,12 +68,8 @@ esma_add_library(${this} ) target_include_directories (${this} PUBLIC $) -target_link_libraries (${this} PUBLIC ESMF::ESMF NetCDF::NetCDF_Fortran) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries (${this} PUBLIC ESMF::ESMF NetCDF::NetCDF_Fortran + PRIVATE OpenMP::OpenMP_Fortran) if (PFUNIT_FOUND) add_subdirectory(tests EXCLUDE_FROM_ALL) diff --git a/generic/ComponentSpecification.F90 b/generic/ComponentSpecification.F90 index 0e6f517d046b..2158e84f3fcd 100644 --- a/generic/ComponentSpecification.F90 +++ b/generic/ComponentSpecification.F90 @@ -1,5 +1,4 @@ module mapl_ComponentSpecification - use mapl_VariableSpecification use mapl_StateSpecification implicit none private diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index c7f59fa19977..13d2a97122c9 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -133,6 +133,7 @@ module MAPL_GenericMod use MaplShared, only: get_file_extension use MAPL_RunEntryPoint use MAPL_ResourceMod + use MAPL_VarSpecTypeMod, only: positive_length use, intrinsic :: ISO_C_BINDING use, intrinsic :: iso_fortran_env, only: REAL32, REAL64, int32, int64 use, intrinsic :: iso_fortran_env, only: OUTPUT_UNIT @@ -3452,7 +3453,7 @@ subroutine MAPL_StateAddExportSpec_(GC, SHORT_NAME, LONG_NAME, & UNGRIDDED_UNIT, UNGRIDDED_NAME, & UNGRIDDED_COORDS, & FIELD_TYPE, STAGGERING, ROTATION, & - DEPENDS_ON, DEPENDS_ON_CHILDREN, RC ) + DEPENDS_ON, DEPENDS_ON_CHILDREN, POSITIVE, RC ) !ARGUMENTS: type (ESMF_GridComp) , intent(INOUT) :: GC @@ -3477,6 +3478,7 @@ subroutine MAPL_StateAddExportSpec_(GC, SHORT_NAME, LONG_NAME, & integer , optional , intent(IN) :: ROTATION logical , optional , intent(IN) :: DEPENDS_ON_CHILDREN character (len=*) , optional , intent(IN) :: DEPENDS_ON(:) + character(len=*) , optional, intent(IN) :: positive integer , optional , intent(OUT) :: RC !EOPI @@ -3543,6 +3545,7 @@ subroutine MAPL_StateAddExportSpec_(GC, SHORT_NAME, LONG_NAME, & ROTATION = ROTATION, & DEPENDS_ON = DEPENDS_ON, & DEPENDS_ON_CHILDREN = DEPENDS_ON_CHILDREN, & + positive = positive, & RC=status ) _VERIFY(status) @@ -6439,6 +6442,7 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC) integer :: rstReq logical :: isPresent logical :: isCreated + character(len=positive_length) :: positive integer :: range_(2) type(MAPL_VarSpec), pointer :: varspec @@ -6487,6 +6491,7 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC) FIELD_TYPE=FIELD_TYPE, & STAGGERING=STAGGERING, & ROTATION=ROTATION, & + positive=positive, & RC=status ) _VERIFY(status) @@ -6772,6 +6777,8 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC) _VERIFY(status) call ESMF_AttributeSet(FIELD, NAME='UNITS', VALUE=UNITS, RC=status) _VERIFY(status) + call ESMF_AttributeSet(FIELD, NAME='POSITIVE', VALUE=positive, RC=status) + _VERIFY(status) call ESMF_AttributeSet(FIELD, NAME='REFRESH_INTERVAL', VALUE=REFRESH, RC=status) _VERIFY(status) @@ -10999,6 +11006,7 @@ subroutine ArrDescrSetNCPar(ArrDes, MPL, tile, offset, num_readers, num_writers, call ArrDescrCreateWriterComm(arrdes,mpl%grid%comm,mpl%grid%num_writers,_RC) call ArrDescrCreateReaderComm(arrdes,mpl%grid%comm,mpl%grid%num_readers,_RC) call mpi_comm_rank(arrdes%ycomm,arrdes%myrow,status) + _VERIFY(status) arrdes%split_restart = mpl%grid%split_restart arrdes%split_checkpoint = mpl%grid%split_checkpoint diff --git a/generic/MaplGeneric.F90 b/generic/MaplGeneric.F90 index 772111c3cbff..06aa96d7dbef 100644 --- a/generic/MaplGeneric.F90 +++ b/generic/MaplGeneric.F90 @@ -2,7 +2,6 @@ module MaplGeneric use mapl_AbstractComponent use mapl_MaplComponent use mapl_ComponentSpecification - use mapl_VariableSpecification use mapl_StateSpecification use mapl_VarSpecMiscMod use mapl_VarSpecVector diff --git a/generic/StateSpecification.F90 b/generic/StateSpecification.F90 index a7a00953d3db..987053a0168c 100644 --- a/generic/StateSpecification.F90 +++ b/generic/StateSpecification.F90 @@ -7,7 +7,7 @@ module mapl_StateSpecification use mapl_ErrorHandlingMod use mapl_VarSpecVector use mapl_VarSpecMiscMod - use mapl_VariableSpecification + use MAPL_VarSpecTypeMod implicit none private @@ -99,6 +99,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME, & ROTATION, & GRID, & DEPENDS_ON, DEPENDS_ON_CHILDREN, & + POSITIVE, & RC ) type (StateSpecification), intent(inout):: SPEC @@ -134,6 +135,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME, & type(ESMF_Grid) , optional , intent(IN) :: GRID logical , optional , intent(IN) :: DEPENDS_ON_CHILDREN character (len=*) , optional , intent(IN) :: DEPENDS_ON(:) + character(len=*) , optional , intent(IN) :: positive integer , optional , intent(OUT) :: RC @@ -172,6 +174,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME, & character(len=ESMF_MAXSTR) :: useableUngrd_Name real , pointer :: usableUNGRIDDED_COORDS(:) => NULL() logical :: usableDEPENDS_ON_CHILDREN + character(len=positive_length) :: usablePositive ! character (len=:), allocatable :: usableDEPENDS_ON(:) INTEGER :: I @@ -413,6 +416,12 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME, & usableUNGRIDDED_COORDS = UNGRIDDED_COORDS end if + if (present(POSITIVE)) then + usablePositive = positive + else + usablePositive = 'down' + end if + I = spec%var_specs%size() allocate(tmp%specptr) @@ -444,6 +453,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME, & TMP%SPECPTR%ROTATION = usableROTATION TMP%SPECPTR%doNotAllocate = .false. TMP%SPECPTR%alwaysAllocate = .false. + TMP%SPECPTR%positive = usablePositive if(associated(usableATTR_IVALUES)) then TMP%SPECPTR%ATTR_IVALUES => usableATTR_IVALUES else diff --git a/generic/VarSpec.F90 b/generic/VarSpec.F90 index c85d4f325c16..646368eb9d3c 100644 --- a/generic/VarSpec.F90 +++ b/generic/VarSpec.F90 @@ -97,6 +97,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & STAGGERING, & ROTATION, & GRID, & + positive, & RC ) type (MAPL_VarSpec ), pointer :: SPEC(:) @@ -130,6 +131,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & integer , optional , intent(IN) :: STAGGERING integer , optional , intent(IN) :: ROTATION type(ESMF_Grid) , optional , intent(IN) :: GRID + character(len=positive_length), optional, intent(in) :: positive integer , optional , intent(OUT) :: RC @@ -151,6 +153,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & integer :: usableSTAGGERING integer :: usableROTATION integer :: usableRESTART + character(len=positive_length) :: usablePositive character(len=ESMF_MAXSTR) :: usableLONG character(len=ESMF_MAXSTR) :: usableUNIT character(len=ESMF_MAXSTR) :: usableFRIENDLYTO @@ -410,6 +413,12 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & usableUNGRIDDED_COORDS = UNGRIDDED_COORDS end if + if (present(positive)) then + usablePositive = positive + else + usablePositive = 'down' + end if + I = size(SPEC) allocate(TMP(I+1),stat=STATUS) @@ -447,6 +456,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & TMP(I+1)%SPECPtr%UNGRIDDED_NAME = useableUngrd_Name TMP(I+1)%SPECPtr%STAGGERING = usableSTAGGERING TMP(I+1)%SPECPtr%ROTATION = usableROTATION + TMP(I+1)%SPECPtr%positive= usablePositive TMP(I+1)%SPECPtr%doNotAllocate = .false. TMP(I+1)%SPECPtr%alwaysAllocate = .false. if(associated(usableATTR_IVALUES)) then @@ -803,6 +813,7 @@ subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & alwaysAllocate, & depends_on_children, & depends_on, & + positive, & RC ) type (MAPL_VarSpec ), intent(IN ) :: SPEC @@ -842,6 +853,7 @@ subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & logical , optional , intent(OUT) :: alwaysAllocate logical , optional , intent(OUT) :: depends_on_children character(len=:), allocatable, optional, intent(OUT) :: depends_on(:) + character(len=*), optional, intent(out) :: positive integer , optional , intent(OUT) :: RC @@ -997,6 +1009,10 @@ subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & end if end if + if(present(positive)) then + positive = SPEC%SPECPtr%positive + end if + _RETURN(ESMF_SUCCESS) end subroutine MAPL_VarSpecGetRegular diff --git a/generic/VarSpecMiscMod.F90 b/generic/VarSpecMiscMod.F90 index 49e95d70008e..6e3e5463e185 100644 --- a/generic/VarSpecMiscMod.F90 +++ b/generic/VarSpecMiscMod.F90 @@ -15,7 +15,6 @@ module MAPL_VarSpecMiscMod use pFlogger use MAPL_Constants use MAPL_ExceptionHandling - use mapl_VariableSpecification use mapl_VarSpecVector use mapl_VarConnVector use MAPL_VarSpecTypeMod diff --git a/generic/VarSpecType.F90 b/generic/VarSpecType.F90 index c22ebe014e47..43864ab4f400 100644 --- a/generic/VarSpecType.F90 +++ b/generic/VarSpecType.F90 @@ -18,6 +18,9 @@ module MAPL_VarSpecTypeMod public :: MAPL_VarSpecType public :: MAPL_VarSpecSet + public :: positive_length + + integer, parameter :: positive_length = 4 type :: MAPL_VarSpecType ! new @@ -36,6 +39,7 @@ module MAPL_VarSpecTypeMod integer, pointer :: UNGRIDDED_DIMS(:) => null() character(len=ESMF_MAXSTR) :: UNGRIDDED_UNIT character(len=ESMF_MAXSTR) :: UNGRIDDED_NAME + character(len=positive_length) :: positive real, pointer :: UNGRIDDED_COORDS(:) integer :: DIMS integer :: LOCATION @@ -84,6 +88,7 @@ subroutine MAPL_VarSpecSetNew(spec, short_name, long_name, units, & grid, & donotallocate, & alwaysallocate, & + positive, & rc ) class(mapl_varspectype), intent(inout) :: spec @@ -107,6 +112,7 @@ subroutine MAPL_VarSpecSetNew(spec, short_name, long_name, units, & type(ESMF_grid) , optional , intent(in) :: grid logical , optional , intent(in) :: donotallocate logical , optional , intent(in) :: alwaysallocate + character(len=positive_length), optional, intent(in) :: positive integer , optional , intent(out) :: rc @@ -191,6 +197,10 @@ subroutine MAPL_VarSpecSetNew(spec, short_name, long_name, units, & spec%alwaysallocate = alwaysallocate endif + if(present(positive)) then + spec%positive = positive + endif + associate( & horz_spec => create_horz_stagger_spec(spec), & vert_spec => create_vert_stagger_spec(spec), & diff --git a/generic/VariableSpecification.F90 b/generic/VariableSpecification.F90 deleted file mode 100644 index 5ec659374a70..000000000000 --- a/generic/VariableSpecification.F90 +++ /dev/null @@ -1,10 +0,0 @@ -module mapl_VariableSpecification - use ESMF - use MAPL_VarSpecTypeMod - use MAPL_VarSpecMod - use MAPL_VarSpecPtrMod - implicit none - private - - -end module mapl_VariableSpecification diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index 20b70e3953fd..8481a9dec79e 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -17,16 +17,12 @@ endif() esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler MAPL.history MAPL.ExtData ${EXTDATA2G_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran $<$:FLAP::FLAP> $<$:FARGPARSE::fargparse>) target_compile_definitions (${this} PRIVATE $<$:BUILD_WITH_EXTDATA2G>) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index 3905711b796a..146e85d2339a 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -285,12 +285,14 @@ subroutine run_model(this, comm, unusable, rc) ! Look for a file called "ESMF.rc" but we want to do this on root and then ! broadcast the result to the other ranks - call MPI_COMM_RANK(comm, rank, ierror) + call MPI_COMM_RANK(comm, rank, status) + _VERIFY(status) if (rank == 0) then inquire(file='ESMF.rc', exist=file_exists) end if - call MPI_BCAST(file_exists, 1, MPI_LOGICAL, 0, comm, ierror) + call MPI_BCAST(file_exists, 1, MPI_LOGICAL, 0, comm, status) + _VERIFY(status) ! If the file exists, we pass it into ESMF_Initialize, else, we ! use the one from the command line arguments @@ -451,18 +453,24 @@ subroutine initialize_mpi(this, unusable, rc) _VERIFY(ierror) if (.not. this%mpi_already_initialized) then + call ESMF_InitializePreMPI(_RC) call MPI_Init_thread(MPI_THREAD_MULTIPLE, provided, ierror) + _VERIFY(ierror) + _ASSERT(provided == MPI_THREAD_MULTIPLE, 'MPI_THREAD_MULTIPLE not supported by this MPI.') else ! If we are here, then MPI has already been initialized by the user ! and we are just using it. But we need to make sure that the user ! has initialized MPI with the correct threading level. call MPI_Query_thread(provided, ierror) + _VERIFY(ierror) end if _ASSERT(provided == MPI_THREAD_MULTIPLE, 'MPI_THREAD_MULTIPLE not supported by this MPI.') - call MPI_Comm_rank(this%comm_world, this%rank, ierror); _VERIFY(ierror) - call MPI_Comm_size(this%comm_world, npes_world, ierror); _VERIFY(ierror) + call MPI_Comm_rank(this%comm_world, this%rank, status) + _VERIFY(status) + call MPI_Comm_size(this%comm_world, npes_world, status) + _VERIFY(status) if ( this%cap_options%npes_model == -1) then ! just a feed back to cap_options to maintain integrity diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 7025bf8035a4..2ee0e4dca2fd 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -229,20 +229,16 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _UNUSED_DUMMY(clock) cap => get_CapGridComp_from_gc(gc) - call MAPL_InternalStateRetrieve(gc, maplobj, rc=status) - _VERIFY(status) + call MAPL_InternalStateRetrieve(gc, maplobj, _RC) t_p => get_global_time_profiler() - call ESMF_GridCompGet(gc, vm = cap%vm, rc = status) - _VERIFY(status) - call ESMF_VMGet(cap%vm, petcount = NPES, mpiCommunicator = comm, rc = status) - _VERIFY(status) + call ESMF_GridCompGet(gc, vm = cap%vm, _RC) + call ESMF_VMGet(cap%vm, petcount = NPES, mpiCommunicator = comm, _RC) AmIRoot_ = MAPL_Am_I_Root(cap%vm) - call MAPL_GetNodeInfo(comm = comm, rc = status) - _VERIFY(STATUS) + call MAPL_GetNodeInfo(comm = comm, _RC) AmIRoot_ = MAPL_Am_I_Root(cap%vm) @@ -254,30 +250,24 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Note the call to GetLogger must be _after_ the call to MAPL_Set(). ! That call establishes the name of this component which is used in ! retrieving this component's logger. - call MAPL_GetLogger(gc, lgr, rc=status) - _VERIFY(status) + call MAPL_GetLogger(gc, lgr, _RC) ! Check if user wants to use node shared memory (default is no) !-------------------------------------------------------------- call MAPL_GetResource(MAPLOBJ, useShmem, label = 'USE_SHMEM:', default = 0, rc = status) if (useShmem /= 0) then - call MAPL_InitializeShmem (rc = status) - _VERIFY(status) + call MAPL_InitializeShmem (_RC) end if ! Check if a valid clock was provided externally !----------------------------------------------- - call ESMF_GridCompGet(gc, clockIsPresent=cap_clock_is_present, rc=status) - _VERIFY(status) + call ESMF_GridCompGet(gc, clockIsPresent=cap_clock_is_present, _RC) if (cap_clock_is_present) then - call ESMF_GridCompGet(gc, clock=cap_clock, rc=status) - _VERIFY(status) - call ESMF_ClockValidate(cap_clock, rc=status) - _VERIFY(status) - cap%clock = ESMF_ClockCreate(cap_clock, rc=status) - _VERIFY(status) + call ESMF_GridCompGet(gc, clock=cap_clock, _RC) + call ESMF_ClockValidate(cap_clock, _RC) + cap%clock = ESMF_ClockCreate(cap_clock, _RC) ! NOTE: We assume the MAPL components will only advance by ! one time step when driven with an external clock. !--------------------------------------------------------- @@ -292,8 +282,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! were after the last advance before the previous Finalize. !--------------------------------------------------------------------------- - call MAPL_ClockInit(MAPLOBJ, cap%clock, nsteps, rc = status) - _VERIFY(status) + call MAPL_ClockInit(MAPLOBJ, cap%clock, nsteps, _RC) cap%nsteps = nsteps cap%compute_throughput = .true. end if @@ -302,14 +291,11 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call set_reference_clock(cap%clock) #endif - call ESMF_ClockGet(cap%clock,currTime=cap%cap_restart_time,rc=status) - _VERIFY(status) + call ESMF_ClockGet(cap%clock,currTime=cap%cap_restart_time,_RC) - cap%clock_hist = ESMF_ClockCreate(cap%clock, rc = STATUS ) ! Create copy for HISTORY - _VERIFY(STATUS) + cap%clock_hist = ESMF_ClockCreate(cap%clock, _RC) ! Create copy for HISTORY - CoresPerNode = MAPL_CoresPerNodeGet(comm,rc=status) - _VERIFY(STATUS) + CoresPerNode = MAPL_CoresPerNodeGet(comm,_RC) ! We check resource for CoresPerNode (no longer needed to be in CAP.rc) ! If it is set in the resource, we issue an warning if the @@ -322,40 +308,30 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) end if end if - call ESMF_VMGet(cap%vm, petcount=npes, mpicommunicator=comm, rc=status) - _VERIFY(status) + call ESMF_VMGet(cap%vm, petcount=npes, mpicommunicator=comm, _RC) _ASSERT(CoresPerNode <= npes, 'something impossible happened') if (cap_clock_is_present) then - call ESMF_ClockGet(cap%clock, timeStep=frequency, rc=status) - _VERIFY(status) - call ESMF_TimeIntervalGet(frequency, s=heartbeat_dt, rc=status) - _VERIFY(status) + call ESMF_ClockGet(cap%clock, timeStep=frequency, _RC) + call ESMF_TimeIntervalGet(frequency, s=heartbeat_dt, _RC) else - call ESMF_ConfigGetAttribute(cap%config, value = heartbeat_dt, Label = "HEARTBEAT_DT:", rc = status) - _VERIFY(status) - call ESMF_TimeIntervalSet(frequency, s = heartbeat_dt, rc = status) - _VERIFY(status) + call ESMF_ConfigGetAttribute(cap%config, value = heartbeat_dt, Label = "HEARTBEAT_DT:", _RC) + call ESMF_TimeIntervalSet(frequency, s = heartbeat_dt, _RC) end if cap%heartbeat_dt = heartbeat_dt - perpetual = ESMF_AlarmCreate(clock = cap%clock_hist, name = 'PERPETUAL', ringinterval = frequency, sticky = .false., rc = status) - _VERIFY(status) - call ESMF_AlarmRingerOff(perpetual, rc = status) - _VERIFY(status) + perpetual = ESMF_AlarmCreate(clock = cap%clock_hist, name = 'PERPETUAL', ringinterval = frequency, sticky = .false., _RC) + call ESMF_AlarmRingerOff(perpetual, _RC) ! Set CLOCK for AGCM if not externally provided ! --------------------------------------------- if (.not.cap_clock_is_present) then - call MAPL_GetResource(MAPLOBJ, cap%perpetual_year, label='PERPETUAL_YEAR:', default = -999, rc = status) - _VERIFY(status) - call MAPL_GetResource(MAPLOBJ, cap%perpetual_month, label='PERPETUAL_MONTH:', default = -999, rc = status) - _VERIFY(status) - call MAPL_GetResource(MAPLOBJ, cap%perpetual_day, label='PERPETUAL_DAY:', default = -999, rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, cap%perpetual_year, label='PERPETUAL_YEAR:', default = -999, _RC) + call MAPL_GetResource(MAPLOBJ, cap%perpetual_month, label='PERPETUAL_MONTH:', default = -999, _RC) + call MAPL_GetResource(MAPLOBJ, cap%perpetual_day, label='PERPETUAL_DAY:', default = -999, _RC) cap%lperp = ((cap%perpetual_day /= -999) .or. (cap%perpetual_month /= -999) .or. (cap%perpetual_year /= -999)) @@ -377,8 +353,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) clockname = trim(clockname) // '_PERPETUAL' call ESMF_Clockset(cap%clock_hist, name = clockname, rc = status) - call Perpetual_Clock(cap, rc=status) - _VERIFY(status) + call Perpetual_Clock(cap, _RC) endif endif @@ -389,86 +364,66 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) !BOR ! !RESOURCE_ITEM: string :: Name of ROOT's config file - call MAPL_GetResource(MAPLOBJ, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", _RC) ! !RESOURCE_ITEM: string :: Name to assign to the ROOT component - call MAPL_GetResource(MAPLOBJ, ROOT_NAME, "ROOT_NAME:", default = "ROOT", rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, ROOT_NAME, "ROOT_NAME:", default = "ROOT", _RC) ! !RESOURCE_ITEM: string :: Name of HISTORY's config file - call MAPL_GetResource(MAPLOBJ, HIST_CF, "HIST_CF:", default = "HIST.rc", rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, HIST_CF, "HIST_CF:", default = "HIST.rc", _RC) ! !RESOURCE_ITEM: string :: Name of ExtData's config file - call MAPL_GetResource(MAPLOBJ, EXTDATA_CF, "EXTDATA_CF:", default = 'ExtData.rc', rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, EXTDATA_CF, "EXTDATA_CF:", default = 'ExtData.rc', _RC) ! !RESOURCE_ITEM: string :: Control Timers - call MAPL_GetResource(MAPLOBJ, enableTimers, "MAPL_ENABLE_TIMERS:", default = 'NO', rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, enableTimers, "MAPL_ENABLE_TIMERS:", default = 'NO', _RC) ! !RESOURCE_ITEM: string :: Control Memory Diagnostic Utility - call MAPL_GetResource(MAPLOBJ, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', rc = status) - _VERIFY(status) - call MAPL_GetResource(MAPLOBJ, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', _RC) + call MAPL_GetResource(MAPLOBJ, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, _RC) !EOR - enableTimers = ESMF_UtilStringUpperCase(enableTimers, rc = status) - _VERIFY(status) + enableTimers = ESMF_UtilStringUpperCase(enableTimers, _RC) call MAPL_GetResource(maplobj,use_extdata2g,"USE_EXTDATA2G:",default=.false.,_RC) if (enableTimers /= 'YES') then - call MAPL_ProfDisable(rc = status) - _VERIFY(status) + call MAPL_ProfDisable(_RC) else call MAPL_GetResource(MAPLOBJ, timerModeStr, "MAPL_TIMER_MODE:", & - default='MINMAX', RC=STATUS ) - _VERIFY(STATUS) + default='MINMAX', _RC ) - timerModeStr = ESMF_UtilStringUpperCase(timerModeStr, rc=STATUS) - _VERIFY(STATUS) + timerModeStr = ESMF_UtilStringUpperCase(timerModeStr, _RC) end if cap%started_loop_timer=.false. - enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, rc=STATUS) - _VERIFY(STATUS) + enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, _RC) if (enableMemUtils /= 'YES') then - call MAPL_MemUtilsDisable( rc=STATUS ) - _VERIFY(STATUS) + call MAPL_MemUtilsDisable( _RC ) else - call MAPL_MemUtilsInit( mode=MemUtilsMode, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_MemUtilsInit( mode=MemUtilsMode, _RC ) end if - call MAPL_GetResource( MAPLOBJ, cap%printSpec, label='PRINTSPEC:', default = 0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, cap%printSpec, label='PRINTSPEC:', default = 0, _RC ) - call dirpaths%append(".",rc=status) - _VERIFY(status) - call ESMF_ConfigFindLabel(cap%config,Label='USER_DIRPATH:',isPresent=foundPath,rc=status) + call dirpaths%append(".",_RC) + call ESMF_ConfigFindLabel(cap%config,Label='USER_DIRPATH:',isPresent=foundPath,_RC) if (foundPath) then tend=.false. do while (.not.tend) - call ESMF_ConfigGetAttribute(cap%config,value=user_dirpath,default='',rc=status) + call ESMF_ConfigGetAttribute(cap%config,value=user_dirpath,default='',_RC) if (tempstring /= '') then - call dirpaths%append(user_dirpath,rc=status) - _VERIFY(status) + call dirpaths%append(user_dirpath,_RC) end if - call ESMF_ConfigNextLine(cap%config,tableEnd=tend,rc=status) - _VERIFY(STATUS) + call ESMF_ConfigNextLine(cap%config,tableEnd=tend,_RC) enddo end if ! Handle RUN_DT in ROOT_CF !------------------------- - cap%cf_root = ESMF_ConfigCreate(rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile(cap%cf_root, ROOT_CF, rc=STATUS ) - _VERIFY(STATUS) + cap%cf_root = ESMF_ConfigCreate(_RC ) + call ESMF_ConfigLoadFile(cap%cf_root, ROOT_CF, _RC ) call ESMF_ConfigGetAttribute(cap%cf_root, value=RUN_DT, Label="RUN_DT:", rc=status) if (STATUS == ESMF_SUCCESS) then @@ -477,63 +432,45 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') end if else - call MAPL_ConfigSetAttribute(cap%cf_root, value=heartbeat_dt, Label="RUN_DT:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_root, value=heartbeat_dt, Label="RUN_DT:", _RC) endif ! Add EXPID and EXPDSC from HISTORY.rc to AGCM.rc !------------------------------------------------ - cap%cf_hist = ESMF_ConfigCreate(rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile(cap%cf_hist, HIST_CF, rc=STATUS ) - _VERIFY(STATUS) + cap%cf_hist = ESMF_ConfigCreate(_RC ) + call ESMF_ConfigLoadFile(cap%cf_hist, HIST_CF, _RC ) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=HIST_CF, Label="HIST_CF:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=HIST_CF, Label="HIST_CF:", _RC) - call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPID, Label="EXPID:", default='', rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPDSC, Label="EXPDSC:", default='', rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPID, Label="EXPID:", default='', _RC) + call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPDSC, Label="EXPDSC:", default='', _RC) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=heartbeat_dt, Label="RUN_DT:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=heartbeat_dt, Label="RUN_DT:", _RC) - call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPID, Label="EXPID:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPDSC, Label="EXPDSC:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPID, Label="EXPID:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPDSC, Label="EXPDSC:", _RC) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=NY, Label="NY:", rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=NX, Label="NX:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=NY, Label="NY:", _RC) ! Add CoresPerNode from CAP.rc to HISTORY.rc and AGCM.rc !------------------------------------------------------- - call MAPL_ConfigSetAttribute(cap%cf_root, value=CoresPerNode, Label="CoresPerNode:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=CoresPerNode, Label="CoresPerNode:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_root, value=CoresPerNode, Label="CoresPerNode:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=CoresPerNode, Label="CoresPerNode:", _RC) ! Add a SINGLE_COLUMN flag in HISTORY.rc based on DYCORE value(from AGCM.rc) !--------------------------------------------------------------------------- - call ESMF_ConfigGetAttribute(cap%cf_root, value=DYCORE, Label="DYCORE:", default = 'FV3', rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value=DYCORE, Label="DYCORE:", default = 'FV3', _RC) if (DYCORE == 'DATMO') then snglcol = 1 - call MAPL_ConfigSetAttribute(cap%cf_hist, value=snglcol, Label="SINGLE_COLUMN:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=snglcol, Label="SINGLE_COLUMN:", _RC) end if ! Detect if this a regular replay in the AGCM.rc ! ---------------------------------------------- - call ESMF_ConfigGetAttribute(cap%cf_root, value=ReplayMode, Label="REPLAY_MODE:", default="NoReplay", rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value=ReplayMode, Label="REPLAY_MODE:", default="NoReplay", _RC) ! Register the children with MAPL @@ -541,40 +478,33 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Create Root child !------------------- - call MAPL_Set(MAPLOBJ, CF=CAP%CF_ROOT, RC=STATUS) - _VERIFY(STATUS) + call MAPL_Set(MAPLOBJ, CF=CAP%CF_ROOT, _RC) root_set_services => cap%root_set_services call t_p%start('SetService') if (.not.allocated(cap%root_dso)) then - cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) - _VERIFY(status) + cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, _RC) else sharedObj = trim(cap%root_dso) - cap%root_id = MAPL_AddChild(MAPLOBJ, root_name, 'setservices_', sharedObj=sharedObj, rc=status) - _VERIFY(status) + cap%root_id = MAPL_AddChild(MAPLOBJ, root_name, 'setservices_', sharedObj=sharedObj, _RC) end if root_gc => maplobj%get_child_gridcomp(cap%root_id) - call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) + call MAPL_GetObjectFromGC(root_gc, root_obj, _RC) _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") ! Create History child !---------------------- - call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, RC=STATUS) - _VERIFY(STATUS) + call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, _RC) - cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, rc = status) - _VERIFY(status) + cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, _RC) ! Create ExtData child !---------------------- - cap%cf_ext = ESMF_ConfigCreate(rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, rc=STATUS ) - _VERIFY(STATUS) + cap%cf_ext = ESMF_ConfigCreate(_RC ) + call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, _RC ) call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) if (STATUS == ESMF_SUCCESS) then @@ -583,12 +513,10 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') end if else - call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", _RC) endif - call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) - _VERIFY(STATUS) + call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, _RC) if (use_extdata2g) then #if defined(BUILD_WITH_EXTDATA2G) @@ -603,25 +531,18 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call t_p%stop('SetService') ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file - call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXPID, Label="EXPID:", rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXPID, Label="EXPID:", _RC) ! Query MAPL for the the children's for GCS, IMPORTS, EXPORTS !------------------------------------------------------------- call MAPL_Get(MAPLOBJ, childrens_gridcomps = cap%gcs, & - childrens_import_states = cap%child_imports, childrens_export_states = cap%child_exports, rc = status) - _VERIFY(status) + childrens_import_states = cap%child_imports, childrens_export_states = cap%child_exports, _RC) ! Inject grid to root child if grid has been set externally @@ -636,10 +557,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) if (cap%printSpec>0) then - call MAPL_StatePrintSpecCSV(cap%gcs(cap%root_id), cap%printspec, rc = status) - _VERIFY(status) - call ESMF_VMBarrier(cap%vm, rc = status) - _VERIFY(status) + call MAPL_StatePrintSpecCSV(cap%gcs(cap%root_id), cap%printspec, _RC) + call ESMF_VMBarrier(cap%vm, _RC) else ! Initialize the Computational Hierarchy !---------------------------------------- @@ -649,20 +568,16 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) exportState = cap%child_exports(cap%root_id), clock = cap%clock, userRC = status) _VERIFY(status) - call cap%initialize_history(rc=status) - _VERIFY(status) + call cap%initialize_history(_RC) - call cap%initialize_extdata(root_gc,rc=status) - _VERIFY(status) + call cap%initialize_extdata(root_gc,_RC) ! Finally check is this is a regular replay ! If so stuff gc and input state for ExtData in GCM internal state ! ----------------------------------------------------------------- if (trim(replayMode)=="Regular") then - call MAPL_GCGet(CAP%GCS(cap%root_id),"GCM",gcmGC,rc=status) - _VERIFY(STATUS) - call ESMF_GridCompGet(gcmGC,vm=gcmVM,rc=status) - _VERIFY(STATUS) + call MAPL_GCGet(CAP%GCS(cap%root_id),"GCM",gcmGC,_RC) + call ESMF_GridCompGet(gcmGC,vm=gcmVM,_RC) _ASSERT(cap%vm==gcmVM,'CAP and GCM should agree on their VMs.') call ESMF_UserCompGetInternalState(gcmGC,'ExtData_state',wrap,status) _VERIFY(STATUS) @@ -688,16 +603,13 @@ subroutine initialize_history(cap, rc) if (present(rc)) rc = ESMF_SUCCESS ! All the EXPORTS of the Hierachy are made IMPORTS of History !------------------------------------------------------------ - call ESMF_StateAdd(cap%child_imports(cap%history_id), [cap%child_exports(cap%root_id)], rc = status) - _VERIFY(STATUS) + call ESMF_StateAdd(cap%child_imports(cap%history_id), [cap%child_exports(cap%root_id)], _RC) - allocate(lswrap%ptr, stat = status) - _VERIFY(STATUS) + allocate(lswrap%ptr, _STAT) call ESMF_UserCompSetInternalState(cap%gcs(cap%history_id), 'MAPL_LocStreamList', & lswrap, STATUS) _VERIFY(STATUS) - call MAPL_GetAllExchangeGrids(CAP%GCS(cap%root_id), LSADDR, RC=STATUS) - _VERIFY(STATUS) + call MAPL_GetAllExchangeGrids(CAP%GCS(cap%root_id), LSADDR, _RC) lswrap%ptr%LSADDR_PTR => LSADDR ! Initialize the History @@ -720,7 +632,7 @@ subroutine initialize_extdata(cap , root_gc, rc) character(len=ESMF_MAXSTR ), pointer :: item_names(:) type(ESMF_Field) :: field type(ESMF_FieldBundle) :: bundle - type(StringVector) :: cap_imports_vec, cap_exports_vec + type(StringVector) :: cap_imports_vec, cap_exports_vec, extdata_imports_vec type(StringVectorIterator) :: iter integer :: i type(ESMF_State) :: state, root_imports, component_state @@ -728,8 +640,9 @@ subroutine initialize_extdata(cap , root_gc, rc) ! Prepare EXPORTS for ExtData ! --------------------------- - cap_imports_vec = get_vec_from_config(cap%config, "CAP_IMPORTS") - cap_exports_vec = get_vec_from_config(cap%config, "CAP_EXPORTS") + cap_imports_vec = get_vec_from_config(cap%config, "CAP_IMPORTS", _RC) + cap_exports_vec = get_vec_from_config(cap%config, "CAP_EXPORTS", _RC) + extdata_imports_vec = get_vec_from_config(cap%config, "EXTDATA_IMPORTS") cap%import_state = ESMF_StateCreate(name = "Cap_Imports", stateintent = ESMF_STATEINTENT_IMPORT) cap%export_state = ESMF_StateCreate(name = "Cap_Exports", stateintent = ESMF_STATEINTENT_EXPORT) @@ -739,35 +652,40 @@ subroutine initialize_extdata(cap , root_gc, rc) do while(iter /= cap_exports_vec%end()) component_name = iter%get() component_name = trim(component_name(index(component_name, ",")+1:)) - field_name = iter%get() field_name = trim(field_name(1:index(field_name, ",")-1)) - call MAPL_ExportStateGet([cap%child_exports(cap%root_id)], component_name, & component_state, status) _VERIFY(status) + call ESMF_StateGet(component_state, trim(field_name), field, _RC) + call MAPL_StateAdd(cap%export_state, field, _RC) + call iter%next() + end do + end if - call ESMF_StateGet(component_state, trim(field_name), field, rc = status) - _VERIFY(status) + if (extdata_imports_vec%size() /= 0) then + iter = extdata_imports_vec%begin() + do while(iter /= extdata_imports_vec%end()) + component_name = iter%get() + component_name = trim(component_name(index(component_name, ",")+1:)) - call MAPL_StateAdd(cap%export_state, field, rc = status) - _VERIFY(status) + field_name = iter%get() + field_name = trim(field_name(1:index(field_name, ",")-1)) + call MAPL_ExportStateGet([cap%child_exports(cap%root_id)], component_name, & + component_state, _RC) + call ESMF_StateGet(component_state, trim(field_name), field, _RC) + call MAPL_StateAdd(cap%child_imports(cap%extdata_id), field, _RC) call iter%next() end do end if - - call ESMF_StateGet(cap%child_imports(cap%root_id), itemcount = item_count, rc = status) - _VERIFY(status) - allocate(item_names(item_count), stat = status) - _VERIFY(status) - allocate(item_types(item_count), stat = status) - _VERIFY(status) + call ESMF_StateGet(cap%child_imports(cap%root_id), itemcount = item_count, _RC) + allocate(item_names(item_count), _STAT) + allocate(item_types(item_count), _STAT) call ESMF_StateGet(cap%child_imports(cap%root_id), itemnamelist = item_names, & - itemtypelist = item_types, rc = status) - _VERIFY(status) + itemtypelist = item_types, _RC) root_imports = cap%child_imports(cap%root_id) do i = 1, item_count @@ -776,18 +694,13 @@ subroutine initialize_extdata(cap , root_gc, rc) else state = cap%child_exports(cap%extdata_id) end if - if (item_types(i) == ESMF_StateItem_Field) then - call ESMF_StateGet(root_imports, item_names(i), field, rc = status) - _VERIFY(status) + call ESMF_StateGet(root_imports, item_names(i), field, _RC) call MAPL_AddAttributeToFields(root_gc,trim(item_names(i)),'RESTART',MAPL_RestartSkip,_RC) - call MAPL_StateAdd(state, field, rc = status) - _VERIFY(status) + call MAPL_StateAdd(state, field, _RC) else if (item_types(i) == ESMF_StateItem_FieldBundle) then - call ESMF_StateGet(root_imports, item_names(i), bundle, rc = status) - _VERIFY(status) - call MAPL_StateAdd(state, bundle, rc = status) - _VERIFY(status) + call ESMF_StateGet(root_imports, item_names(i), bundle, _RC) + call MAPL_StateAdd(state, bundle, _RC) end if end do @@ -825,10 +738,10 @@ subroutine run_gc(gc, import, export, clock, rc) t_p => get_global_time_profiler() call t_p%start('Run') - call ESMF_GridCompGet( gc, currentPhase=phase, RC=status ) + call ESMF_GridCompGet( gc, currentPhase=phase, _RC ) VERIFY_(status) - call run_MAPL_GridComp(gc, phase=phase, rc=status) + call run_MAPL_GridComp(gc, phase=phase, _RC) _VERIFY(status) call t_p%stop('Run') @@ -855,8 +768,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) _UNUSED_DUMMY(clock) cap => get_CapGridComp_from_gc(gc) - call MAPL_GetObjectFromGC(gc, maplobj, rc=status) - _VERIFY(status) + call MAPL_GetObjectFromGC(gc, maplobj, _RC) t_p => get_global_time_profiler() call t_p%start('Finalize') @@ -876,20 +788,14 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) _VERIFY(status) - call CAP_Finalize(CAP%CLOCK_HIST, "cap_restart", rc=STATUS) - _VERIFY(status) + call CAP_Finalize(CAP%CLOCK_HIST, "cap_restart", _RC) - call ESMF_ConfigDestroy(cap%cf_ext, rc = status) - _VERIFY(status) - call ESMF_ConfigDestroy(cap%cf_hist, rc = status) - _VERIFY(status) - call ESMF_ConfigDestroy(cap%cf_root, rc = status) - _VERIFY(status) - call ESMF_ConfigDestroy(cap%config, rc = status) - _VERIFY(status) + call ESMF_ConfigDestroy(cap%cf_ext, _RC) + call ESMF_ConfigDestroy(cap%cf_hist, _RC) + call ESMF_ConfigDestroy(cap%cf_root, _RC) + call ESMF_ConfigDestroy(cap%config, _RC) - call MAPL_FinalizeShmem(rc = status) - _VERIFY(STATUS) + call MAPL_FinalizeShmem(_RC) ! Write EGRESS file !------------------ @@ -918,16 +824,13 @@ subroutine set_services_gc(gc, rc) type(MAPL_CapGridComp), pointer :: cap cap => get_CapGridComp_from_gc(gc) - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, _RC) do phase = 1, cap%n_run_phases - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, userRoutine = run_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, userRoutine = run_gc, _RC) enddo - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_FINALIZE, userRoutine = finalize_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_FINALIZE, userRoutine = finalize_gc, _RC) _RETURN(ESMF_SUCCESS) end subroutine set_services_gc @@ -938,8 +841,7 @@ subroutine set_services(this, rc) integer, optional, intent(out) :: rc integer :: status - call ESMF_GridCompSetServices(this%gc, set_services_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetServices(this%gc, set_services_gc, _RC) _RETURN(ESMF_SUCCESS) end subroutine set_services @@ -967,8 +869,7 @@ subroutine run(this, phase, rc) phase_ = 1 if (present(phase)) phase_ = phase - call ESMF_GridCompRun(this%gc, phase=phase_, userrc=userrc, rc=status) - _VERIFY(status) + call ESMF_GridCompRun(this%gc, phase=phase_, userrc=userrc, _RC) _VERIFY(userrc) _RETURN(ESMF_SUCCESS) @@ -980,8 +881,7 @@ subroutine finalize(this, rc) integer :: status - call ESMF_GridCompFinalize(this%gc, rc = status) - _VERIFY(status) + call ESMF_GridCompFinalize(this%gc, _RC) _RETURN(ESMF_SUCCESS) end subroutine finalize @@ -1029,8 +929,7 @@ function get_current_time(this, rc) result (current_time) type(ESMF_Time) :: current_time integer, optional, intent(out) :: rc integer :: status - call ESMF_ClockGet(this%clock,currTime=current_time,rc=status) - _VERIFY(status) + call ESMF_ClockGet(this%clock,currTime=current_time,_RC) _RETURN(ESMF_SUCCESS) @@ -1067,28 +966,28 @@ end function get_CapGridComp_from_gc - function get_vec_from_config(config, key) result(vec) + function get_vec_from_config(config, key, rc) result(vec) type(ESMF_Config), intent(inout) :: config character(len=*), intent(in) :: key - logical :: present - integer :: status, rc + integer, intent(out), optional :: rc + logical :: present, tableEnd + integer :: status character(len=ESMF_MAXSTR) :: cap_import type(StringVector) :: vec - call ESMF_ConfigFindLabel(config, key//":", isPresent = present, rc = status) - _VERIFY(status) + call ESMF_ConfigFindLabel(config, key//":", isPresent = present, _RC) cap_import = "" if (present) then do while(trim(cap_import) /= "::") - call ESMF_ConfigNextLine(config, rc = status) - _VERIFY(status) - call ESMF_ConfigGetAttribute(config, cap_import, rc = status) - _VERIFY(status) + call ESMF_ConfigNextLine(config, tableEnd=tableEnd, _RC) + if (tableEnd) exit + call ESMF_ConfigGetAttribute(config, cap_import, _RC) if (trim(cap_import) /= "::") call vec%push_back(trim(cap_import)) end do end if + _RETURN(_SUCCESS) end function get_vec_from_config @@ -1128,8 +1027,7 @@ subroutine run_MAPL_GridComp(gc, phase, rc) procedure(), pointer :: root_set_services cap => get_CapGridComp_from_gc(gc) - call MAPL_GetObjectFromGC(gc, maplobj, rc=status) - _VERIFY(status) + call MAPL_GetObjectFromGC(gc, maplobj, _RC) phase_ = 1 if (present(phase)) phase_ = phase @@ -1139,8 +1037,7 @@ subroutine run_MAPL_GridComp(gc, phase, rc) ! Time Loop starts by checking for Segment Ending Time !----------------------------------------------------- if (cap%compute_throughput) then - call ESMF_VMBarrier(cap%vm,rc=status) - _VERIFY(status) + call ESMF_VMBarrier(cap%vm,_RC) cap%starts%loop_start_timer = MPI_WTime() cap%started_loop_timer = .true. end if @@ -1151,25 +1048,21 @@ subroutine run_MAPL_GridComp(gc, phase, rc) call cap%increment_step_counter() - call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', rc = status) - _VERIFY(status) + call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', _RC) if (.not.cap%lperp) then - done = ESMF_ClockIsStopTime(cap%clock_hist, rc = status) - _VERIFY(status) + done = ESMF_ClockIsStopTime(cap%clock_hist, _RC) if (done) exit endif - call cap%step(phase=phase_, rc=status) - _VERIFY(status) + call cap%step(phase=phase_, _RC) ! Reset loop average timer to get a better ! estimate of true run time left by ignoring ! initialization costs in the averageing. !------------------------------------------- if (n == 1 .and. cap%compute_throughput) then - call ESMF_VMBarrier(cap%vm,rc=status) - _VERIFY(status) + call ESMF_VMBarrier(cap%vm,_RC) cap%starts%loop_start_timer = MPI_WTime() endif @@ -1200,8 +1093,7 @@ subroutine step(this, unusable, phase, rc) ! -------------------------- if (phase_ == 1) then - call first_phase(rc=status) - _VERIFY(status) + call first_phase(_RC) endif ! phase_ == 1 ! Run the Gridded Component @@ -1214,8 +1106,7 @@ subroutine step(this, unusable, phase, rc) ! --------------------------------------------------- if (phase_ == this%n_run_phases) then - call last_phase(rc=status) - _VERIFY(STATUS) + call last_phase(_RC) endif !phase_ == last @@ -1252,8 +1143,7 @@ subroutine first_phase(rc) _VERIFY(status) if (this%compute_throughput) then - call ESMF_VMBarrier(this%vm,rc=status) - _VERIFY(status) + call ESMF_VMBarrier(this%vm,_RC) this%starts%start_run_timer = MPI_WTime() end if @@ -1266,15 +1156,12 @@ subroutine last_phase(rc) integer :: status if (this%compute_throughput) then - call ESMF_VMBarrier(this%vm,rc=status) - _VERIFY(status) + call ESMF_VMBarrier(this%vm,_RC) end_run_timer = MPI_WTime() end if - call ESMF_ClockAdvance(this%clock, rc = status) - _VERIFY(STATUS) - call ESMF_ClockAdvance(this%clock_hist, rc = status) - _VERIFY(STATUS) + call ESMF_ClockAdvance(this%clock, _RC) + call ESMF_ClockAdvance(this%clock_hist, _RC) ! Update Perpetual Clock ! ---------------------- @@ -1290,8 +1177,7 @@ subroutine last_phase(rc) ! Estimate throughput times ! --------------------------- if (this%compute_throughput) then - call print_throughput(rc=status) - _VERIFY(STATUS) + call print_throughput(_RC) end if _RETURN(_SUCCESS) @@ -1314,19 +1200,16 @@ subroutine print_throughput(rc) integer :: HRS_R, MIN_R, SEC_R - call ESMF_ClockGet(this%clock, CurrTime = currTime, rc = status) - _VERIFY(status) + call ESMF_ClockGet(this%clock, CurrTime = currTime, _RC) call ESMF_TimeGet(CurrTime, YY = AGCM_YY, & MM = AGCM_MM, & DD = AGCM_DD, & H = AGCM_H , & M = AGCM_M , & - S = AGCM_S, rc=status) - _VERIFY(status) + S = AGCM_S, _RC) delt=currTime-this%cap_restart_time ! Call system clock to estimate throughput simulated Days/Day - call ESMF_VMBarrier( this%vm, RC=STATUS ) - _VERIFY(STATUS) + call ESMF_VMBarrier( this%vm, _RC ) END_TIMER = MPI_Wtime() n=this%get_step_counter() !GridCompRun Timer [Inst] @@ -1343,11 +1226,9 @@ subroutine print_throughput(rc) ! Reset Inst timer this%starts%start_timer = END_TIMER ! Get percent of used memory - call MAPL_MemUsed ( mem_total, mem_used, mem_used_percent, RC=STATUS ) - _VERIFY(STATUS) + call MAPL_MemUsed ( mem_total, mem_used, mem_used_percent, _RC ) ! Get percent of committed memory - call MAPL_MemCommited ( mem_total, mem_commit, mem_committed_percent, RC=STATUS ) - _VERIFY(STATUS) + call MAPL_MemCommited ( mem_total, mem_commit, mem_committed_percent, _RC ) if( mapl_am_I_Root(this%vm) ) write(6,1000) AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S,& LOOP_THROUGHPUT,INST_THROUGHPUT,RUN_THROUGHPUT,HRS_R,MIN_R,SEC_R,& @@ -1370,21 +1251,17 @@ subroutine record_state(this, rc) integer :: nalarms,i - call MAPL_GetObjectFromGC(this%gcs(this%root_id),maplobj,rc=status) - _VERIFY(status) + call MAPL_GetObjectFromGC(this%gcs(this%root_id),maplobj,_RC) call MAPL_GenericStateSave(this%gcs(this%root_id),this%child_imports(this%root_id), & - this%child_exports(this%root_id),this%clock,rc=status) + this%child_exports(this%root_id),this%clock,_RC) - call ESMF_ClockGet(this%clock,alarmCount=nalarms,rc=status) - _VERIFY(status) + call ESMF_ClockGet(this%clock,alarmCount=nalarms,_RC) - allocate(this%alarm_list(nalarms),this%ringingState(nalarms),this%alarmRingTime(nalarms),stat=status) - _VERIFY(status) + allocate(this%alarm_list(nalarms),this%ringingState(nalarms),this%alarmRingTime(nalarms),_STAT) call ESMF_ClockGetAlarmList(this%clock, alarmListFlag=ESMF_ALARMLIST_ALL, & - alarmList=this%alarm_list, rc=status) - _VERIFY(status) + alarmList=this%alarm_list, _RC) do i = 1, nalarms - call ESMF_AlarmGet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), rc=status) + call ESMF_AlarmGet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), _RC) VERIFY_(STATUS) end do @@ -1399,11 +1276,9 @@ subroutine refresh_state(this, rc) integer :: i call MAPL_GenericStateRestore(this%gcs(this%root_id),this%child_imports(this%root_id), & - this%child_exports(this%root_id),this%clock,rc=status) - _VERIFY(status) + this%child_exports(this%root_id),this%clock,_RC) DO I = 1, size(this%alarm_list) - call ESMF_AlarmSet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), rc=status) - _VERIFY(STATUS) + call ESMF_AlarmSet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), _RC) END DO _RETURN(_SUCCESS) @@ -1421,10 +1296,8 @@ subroutine get_field_from_import(this,field_name,state_name,field,rc) type(ESMF_State) :: state call MAPL_ImportStateGet(this%gcs(this%root_id),this%child_imports(this%root_id),& - state_name,state,rc=status) - _VERIFY(status) - call ESMF_StateGet(state,trim(field_name),field,rc=status) - _VERIFY(status) + state_name,state,_RC) + call ESMF_StateGet(state,trim(field_name),field,_RC) _RETURN(_SUCCESS) end subroutine get_field_from_import @@ -1439,10 +1312,8 @@ subroutine get_field_from_internal(this,field_name,state_name,field,rc) type(ESMF_State) :: state - call MAPL_InternalESMFStateGet(this%gcs(this%root_id),state_name,state,rc=status) - _VERIFY(status) - call ESMF_StateGet(state,trim(field_name),field,rc=status) - _VERIFY(status) + call MAPL_InternalESMFStateGet(this%gcs(this%root_id),state_name,state,_RC) + call ESMF_StateGet(state,trim(field_name),field,_RC) _RETURN(_SUCCESS) end subroutine get_field_from_internal @@ -1548,8 +1419,7 @@ subroutine destroy_state(this, rc) integer, intent(out) :: rc integer :: status - call MAPL_DestroyStateSave(this%gcs(this%root_id),rc=status) - _VERIFY(status) + call MAPL_DestroyStateSave(this%gcs(this%root_id),_RC) if (allocated(this%alarm_list)) deallocate(this%alarm_list) if (allocated(this%AlarmRingTime)) deallocate(this%alarmRingTime) @@ -1566,36 +1436,26 @@ subroutine rewind_clock(this, time, rc) integer :: status type(ESMF_Time) :: current_time,ct - call ESMF_ClockGet(this%clock,currTime=current_time,rc=status) - _VERIFY(status) + call ESMF_ClockGet(this%clock,currTime=current_time,_RC) if (current_time > time) then - call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_REVERSE,rc=status) - _VERIFY(status) + call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_REVERSE,_RC) do - call ESMF_ClockAdvance(this%clock,rc=status) - _VERIFY(status) - call ESMF_ClockGet(this%clock,currTime=ct,rc=status) - _VERIFY(status) + call ESMF_ClockAdvance(this%clock,_RC) + call ESMF_ClockGet(this%clock,currTime=ct,_RC) if (ct==time) exit enddo - call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_FORWARD,rc=status) - _VERIFY(status) + call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_FORWARD,_RC) end if - call ESMF_ClockGet(this%clock_hist,currTime=current_time,rc=status) - _VERIFY(status) + call ESMF_ClockGet(this%clock_hist,currTime=current_time,_RC) if (current_time > time) then - call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_REVERSE,rc=status) - _VERIFY(status) + call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_REVERSE,_RC) do - call ESMF_ClockAdvance(this%clock_hist,rc=status) - _VERIFY(status) - call ESMF_ClockGet(this%clock_hist,currTime=ct,rc=status) - _VERIFY(status) + call ESMF_ClockAdvance(this%clock_hist,_RC) + call ESMF_ClockGet(this%clock_hist,currTime=ct,_RC) if (ct==time) exit enddo - call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_FORWARD,rc=status) - _VERIFY(status) + call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_FORWARD,_RC) end if @@ -1679,7 +1539,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) !BOR - call MAPL_GetResource( MAPLOBJ, datetime, label='BEG_DATE:', rc=STATUS ) + call MAPL_GetResource( MAPLOBJ, datetime, label='BEG_DATE:', _RC ) if(STATUS==ESMF_SUCCESS) then _ASSERT(is_valid_date(datetime(1)),'Invalid date in BEG_DATE') _ASSERT(is_valid_time(datetime(2)),'Invalid time in BEG_DATE') @@ -1687,93 +1547,71 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) else ! !RESOURCE_ITEM: year :: Beginning year (integer) - call MAPL_GetResource( MAPLOBJ, BEG_YY, label='BEG_YY:', DEFAULT=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_YY, label='BEG_YY:', DEFAULT=1, _RC ) ! !RESOURCE_ITEM: month :: Beginning month (integer 1-12) - call MAPL_GetResource( MAPLOBJ, BEG_MM, label='BEG_MM:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_MM, label='BEG_MM:', default=1, _RC ) ! !RESOURCE_ITEM: day :: Beginning day of month (integer 1-31) - call MAPL_GetResource( MAPLOBJ, BEG_DD, label='BEG_DD:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_DD, label='BEG_DD:', default=1, _RC ) ! !RESOURCE_ITEM: hour :: Beginning hour of day (integer 0-23) - call MAPL_GetResource( MAPLOBJ, BEG_H , label='BEG_H:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_H , label='BEG_H:' , default=0, _RC ) ! !RESOURCE_ITEM: minute :: Beginning minute (integer 0-59) - call MAPL_GetResource( MAPLOBJ, BEG_M , label='BEG_M:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_M , label='BEG_M:' , default=0, _RC ) ! !RESOURCE_ITEM: second :: Beginning second (integer 0-59) - call MAPL_GetResource( MAPLOBJ, BEG_S , label='BEG_S:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_S , label='BEG_S:' , default=0, _RC ) end if - call MAPL_GetResource( MAPLOBJ, datetime, label='END_DATE:', rc=STATUS ) + call MAPL_GetResource( MAPLOBJ, datetime, label='END_DATE:', _RC ) if(STATUS==ESMF_SUCCESS) then _ASSERT(is_valid_date(datetime(1)),'Invalid date in END_DATE') _ASSERT(is_valid_time(datetime(2)),'Invalid time in END_DATE') CALL MAPL_UnpackDateTime(DATETIME, END_YY, END_MM, END_DD, END_H, END_M, END_S) else ! !RESOURCE_ITEM: year :: Ending year (integer) - call MAPL_GetResource( MAPLOBJ, END_YY, label='END_YY:', DEFAULT=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_YY, label='END_YY:', DEFAULT=1, _RC ) ! !RESOURCE_ITEM: month :: Ending month (integer 1-12) - call MAPL_GetResource( MAPLOBJ, END_MM, label='END_MM:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_MM, label='END_MM:', default=1, _RC ) ! !RESOURCE_ITEM: day :: Ending day of month (integer 1-31) - call MAPL_GetResource( MAPLOBJ, END_DD, label='END_DD:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_DD, label='END_DD:', default=1, _RC ) ! !RESOURCE_ITEM: hour :: Ending hour of day (integer 0-23) - call MAPL_GetResource( MAPLOBJ, END_H , label='END_H:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_H , label='END_H:' , default=0, _RC ) ! !RESOURCE_ITEM: minute :: Ending minute (integer 0-59) - call MAPL_GetResource( MAPLOBJ, END_M , label='END_M:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_M , label='END_M:' , default=0, _RC ) ! !RESOURCE_ITEM: second :: Ending second (integer 0-59) - call MAPL_GetResource( MAPLOBJ, END_S , label='END_S:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_S , label='END_S:' , default=0, _RC ) end if ! Replace JOB_DURATION with JOB_SGMT as prefered RC parameter ! ----------------------------------------------------------- - call MAPL_GetResource( MAPLOBJ, datetime, label='JOB_SGMT:', rc=STATUS ) + call MAPL_GetResource( MAPLOBJ, datetime, label='JOB_SGMT:', _RC ) if(STATUS/=ESMF_SUCCESS) then - call MAPL_GetResource( MAPLOBJ, datetime, label='JOB_DURATION:', rc=STATUS ) + call MAPL_GetResource( MAPLOBJ, datetime, label='JOB_DURATION:', _RC ) end if if(STATUS==ESMF_SUCCESS) then CALL MAPL_UnpackDateTime(DATETIME, DUR_YY, DUR_MM, DUR_DD, DUR_H, DUR_M, DUR_S) else ! !RESOURCE_ITEM: year :: Ending year (integer) - call MAPL_GetResource( MAPLOBJ, DUR_YY, label='DUR_YY:', DEFAULT=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_YY, label='DUR_YY:', DEFAULT=0, _RC ) ! !RESOURCE_ITEM: month :: Ending month (integer 1-12) - call MAPL_GetResource( MAPLOBJ, DUR_MM, label='DUR_MM:', default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_MM, label='DUR_MM:', default=0, _RC ) ! !RESOURCE_ITEM: day :: Ending day of month (integer 1-31) - call MAPL_GetResource( MAPLOBJ, DUR_DD, label='DUR_DD:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_DD, label='DUR_DD:', default=1, _RC ) ! !RESOURCE_ITEM: hour :: Ending hour of day (integer 0-23) - call MAPL_GetResource( MAPLOBJ, DUR_H , label='DUR_H:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_H , label='DUR_H:' , default=0, _RC ) ! !RESOURCE_ITEM: minute :: Ending minute (integer 0-59) - call MAPL_GetResource( MAPLOBJ, DUR_M , label='DUR_M:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_M , label='DUR_M:' , default=0, _RC ) ! !xRESOURCE_ITEM: second :: Ending second (integer 0-59) - call MAPL_GetResource( MAPLOBJ, DUR_S , label='DUR_S:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_S , label='DUR_S:' , default=0, _RC ) end if ! !RESOURCE_ITEM: seconds :: Interval of the application clock (the Heartbeat) - call MAPL_GetResource( MAPLOBJ, HEARTBEAT_DT, label='HEARTBEAT_DT:', rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, HEARTBEAT_DT, label='HEARTBEAT_DT:', _RC ) ! !RESOURCE_ITEM: 1 :: numerator of decimal fraction of time step - call MAPL_GetResource( MAPLOBJ, NUM_DT, label='NUM_DT:', default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, NUM_DT, label='NUM_DT:', default=0, _RC ) ! !RESOURCE_ITEM: 1 :: denominator of decimal fraction of time step - call MAPL_GetResource( MAPLOBJ, DEN_DT, label='DEN_DT:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DEN_DT, label='DEN_DT:', default=1, _RC ) ! !RESOURCE_ITEM: string :: Calendar type - call MAPL_GetResource( MAPLOBJ, calendar, label='CALENDAR:', default="GREGORIAN", rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, calendar, label='CALENDAR:', default="GREGORIAN", _RC ) !EOR @@ -1786,20 +1624,14 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) ! ---------------------------------------- if (calendar=="GREGORIAN") then - cal = ESMF_CalendarCreate( ESMF_CALKIND_GREGORIAN, name="ApplicationCalendar", rc=status ) - _VERIFY(STATUS) - call ESMF_CalendarSetDefault(ESMF_CALKIND_GREGORIAN, RC=STATUS) - _VERIFY(STATUS) + cal = ESMF_CalendarCreate( ESMF_CALKIND_GREGORIAN, name="ApplicationCalendar", _RC ) + call ESMF_CalendarSetDefault(ESMF_CALKIND_GREGORIAN, _RC) elseif(calendar=="JULIAN" ) then - cal = ESMF_CalendarCreate( ESMF_CALKIND_JULIAN, name="ApplicationCalendar", rc=status ) - _VERIFY(STATUS) - call ESMF_CalendarSetDefault(ESMF_CALKIND_JULIAN, RC=STATUS) - _VERIFY(STATUS) + cal = ESMF_CalendarCreate( ESMF_CALKIND_JULIAN, name="ApplicationCalendar", _RC ) + call ESMF_CalendarSetDefault(ESMF_CALKIND_JULIAN, _RC) elseif(calendar=="NOLEAP" ) then - cal = ESMF_CalendarCreate( ESMF_CALKIND_NOLEAP, name="ApplicationCalendar", rc=status ) - _VERIFY(STATUS) - call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, RC=STATUS) - _VERIFY(STATUS) + cal = ESMF_CalendarCreate( ESMF_CALKIND_NOLEAP, name="ApplicationCalendar", _RC ) + call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, _RC) else _FAIL('Unsupported calendar:'//trim(calendar)) endif @@ -1813,8 +1645,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) H = BEG_H , & M = BEG_M , & S = BEG_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) + calendar=cal, _RC) call ESMF_TimeSet( EndTime, YY = END_YY, & MM = END_MM, & @@ -1822,8 +1653,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) H = END_H , & M = END_M , & S = END_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) + calendar=cal, _RC) ! Read CAP Restart File for Current Time ! -------------------------------------- @@ -1835,8 +1665,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) CUR_M = BEG_M CUR_S = BEG_S - UNIT = GETFILE ( "cap_restart", form="formatted", ALL_PES=.true., rc=status ) - _VERIFY(STATUS) + UNIT = GETFILE ( "cap_restart", form="formatted", ALL_PES=.true., _RC ) rewind(UNIT) read(UNIT,100,err=999,end=999) datetime @@ -1846,11 +1675,10 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) _ASSERT(is_valid_time(DATETIME(2)),'Invalid time in cap_restart') CALL MAPL_UnpackDateTime(DATETIME, CUR_YY, CUR_MM, CUR_DD, CUR_H, CUR_M, CUR_S) - call MAPL_GetLogger(MAPLOBJ, lgr, rc=status) - _VERIFY(status) + call MAPL_GetLogger(MAPLOBJ, lgr, _RC) call lgr%info('Read CAP restart properly, Current Date = %i4.4~/%i2.2~/%i2.2', CUR_YY, CUR_MM, CUR_DD) - call lgr%info(' Current Time = %i2.2~/%i2.2~/%i2.2', CUR_H, CUR_M, CUR_S) + call lgr%info(' Current Time = %i2.2~:%i2.2~:%i2.2', CUR_H, CUR_M, CUR_S) 999 continue ! Initialize Current time @@ -1863,8 +1691,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) H = CUR_H , & M = CUR_M , & S = CUR_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) + calendar=cal, _RC) ! initialize final stop time @@ -1877,8 +1704,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) M = DUR_M , & S = DUR_S , & startTime = currTime, & - rc = STATUS ) - _VERIFY(STATUS) + _RC) maxDuration = EndTime - currTime if (duration > maxDuration) duration = maxDuration @@ -1888,8 +1714,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) ! initialize model time step ! -------------------------- - call ESMF_TimeIntervalSet( timeStep, S=HEARTBEAT_DT, sN=NUM_DT, sD=DEN_DT, rc=STATUS ) - _VERIFY(STATUS) + call ESMF_TimeIntervalSet( timeStep, S=HEARTBEAT_DT, sN=NUM_DT, sD=DEN_DT, _RC ) nsteps = duration/timestep @@ -1900,15 +1725,13 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) if (endTime < stopTime) then clock = ESMF_ClockCreate( name="ApplClock", timeStep=timeStep, & - startTime=StartTime, stopTime=EndTime, rc=STATUS ) + startTime=StartTime, stopTime=EndTime, _RC ) else clock = ESMF_ClockCreate( name="ApplClock", timeStep=timeStep, & - startTime=StartTime, stopTime=StopTime, rc=STATUS ) + startTime=StartTime, stopTime=StopTime, _RC ) end if - _VERIFY(STATUS) - call ESMF_ClockSet ( clock, CurrTime=CurrTime, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockSet ( clock, CurrTime=CurrTime, _RC ) _RETURN(ESMF_SUCCESS) end subroutine MAPL_ClockInit @@ -1934,15 +1757,13 @@ subroutine CAP_FINALIZE ( clock,filen, rc ) ! Retrieve Current Time for Cap Restart ! ------------------------------------- - call ESMF_ClockGet ( clock, currTime=currentTime, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGet ( clock, currTime=currentTime, _RC ) call ESMF_TimeGet ( CurrentTime, YY = YY, & MM = MM, & DD = DD, & H = H , & M = M , & - S = S, rc=status ) - _VERIFY(STATUS) + S = S, _RC ) CALL MAPL_PackDateTime(DATETIME, YY, MM, DD, H, M, S) @@ -1982,33 +1803,26 @@ subroutine Perpetual_Clock (this, rc) perpetual_year = this%perpetual_year perpetual_month = this%perpetual_month perpetual_day = this%perpetual_day - call MAPL_GetLogger(this%gc, lgr, rc=status) - _VERIFY(status) + call MAPL_GetLogger(this%gc, lgr, _RC) - call ESMF_ClockGetAlarm ( clock_HIST, alarmName='PERPETUAL', alarm=PERPETUAL, rc=status ) - _VERIFY(STATUS) - call ESMF_AlarmRingerOff( PERPETUAL, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGetAlarm ( clock_HIST, alarmName='PERPETUAL', alarm=PERPETUAL, _RC ) + call ESMF_AlarmRingerOff( PERPETUAL, _RC ) - call ESMF_ClockGet ( clock, currTime=currTime, calendar=cal, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGet ( clock, currTime=currTime, calendar=cal, _RC ) call ESMF_TimeGet ( CurrTime, YY = AGCM_YY, & MM = AGCM_MM, & DD = AGCM_DD, & H = AGCM_H , & M = AGCM_M , & - S = AGCM_S, rc=status ) - _VERIFY(STATUS) + S = AGCM_S, _RC ) - call ESMF_ClockGet ( clock_HIST, CurrTime=CurrTime, calendar=cal, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGet ( clock_HIST, CurrTime=CurrTime, calendar=cal, _RC ) call ESMF_TimeGet ( CurrTime, YY = HIST_YY, & MM = HIST_MM, & DD = HIST_DD, & H = HIST_H , & M = HIST_M , & - S = HIST_S, rc=status ) - _VERIFY(STATUS) + S = HIST_S, _RC ) call lgr%debug('Inside PERP M0: %i4.4~/%i2.2~/%i2.2 Time: %i2.2~/%i2.2~/%i2.2', AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S) call lgr%debug('Inside PERP H0: %i4.4~/%i2.2~/%i2.2 Time: %i2.2~/%i2.2~/%i2.2', HIST_YY,HIST_MM,HIST_DD,HIST_H,HIST_M,HIST_S) @@ -2027,8 +1841,7 @@ subroutine Perpetual_Clock (this, rc) if( HIST_MM /= PERPETUAL_MONTH ) then HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 - call ESMF_AlarmRingerOn( PERPETUAL, rc=status ) - _VERIFY(STATUS) + call ESMF_AlarmRingerOn( PERPETUAL, _RC ) endif call lgr%debug('Inside PERP M0: %i4.4~/%i2.2~/%i2.2 Time: %i2.2~/%i2.2~/%i2.2', AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S) @@ -2044,8 +1857,7 @@ subroutine Perpetual_Clock (this, rc) HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 AGCM_YY = HIST_YY - call ESMF_AlarmRingerOn( PERPETUAL, rc=status ) - _VERIFY(STATUS) + call ESMF_AlarmRingerOn( PERPETUAL, _RC ) endif endif @@ -2058,8 +1870,7 @@ subroutine Perpetual_Clock (this, rc) if( HIST_MM /= PERPETUAL_MONTH ) then HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 - call ESMF_AlarmRingerOn( PERPETUAL, rc=status ) - _VERIFY(STATUS) + call ESMF_AlarmRingerOn( PERPETUAL, _RC ) endif endif @@ -2069,10 +1880,8 @@ subroutine Perpetual_Clock (this, rc) H = AGCM_H , & M = AGCM_M , & S = AGCM_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) - call ESMFL_ClockSet ( clock, CurrTime=CurrTime, rc=status ) - _VERIFY(STATUS) + calendar=cal, _RC) + call ESMFL_ClockSet ( clock, CurrTime=CurrTime, _RC ) call ESMF_TimeSet( CurrTime, YY = HIST_YY, & MM = HIST_MM, & @@ -2080,10 +1889,8 @@ subroutine Perpetual_Clock (this, rc) H = HIST_H , & M = HIST_M , & S = HIST_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) - call ESMFL_ClockSet ( clock_HIST, CurrTime=CurrTime, rc=status ) - _VERIFY(STATUS) + calendar=cal, _RC) + call ESMFL_ClockSet ( clock_HIST, CurrTime=CurrTime, _RC ) _RETURN(ESMF_SUCCESS) end subroutine Perpetual_Clock @@ -2113,26 +1920,21 @@ subroutine ESMFL_ClockSet(clock, currTime, rc) targetTime = currTime ! get the CurrentTime from the clock - call ESMF_ClockGet(clock, alarmCount = nalarms, currTime=cTime, rc=status) - _VERIFY(STATUS) + call ESMF_ClockGet(clock, alarmCount = nalarms, currTime=cTime, _RC) delt = targetTime - cTime - call ESMF_TimeIntervalSet(zero, rc=status) - _VERIFY(STATUS) + call ESMF_TimeIntervalSet(zero, _RC) ! Get the list of current alarms in the clock - allocate (alarmList(nalarms), stat = status) - _VERIFY(STATUS) + allocate (alarmList(nalarms), _STAT) call ESMF_ClockGetAlarmList(clock, alarmListFlag=ESMF_ALARMLIST_ALL, & - alarmList=alarmList, alarmCount = nalarms, rc=status) - _VERIFY(STATUS) + alarmList=alarmList, alarmCount = nalarms, _RC) ! Loop over all alarms DO I = 1, nalarms call ESMF_AlarmGet(alarmList(I), ringTime=ringTime, ringInterval=ringInterval, & - ringing=ringing, rc=status) - _VERIFY(STATUS) + ringing=ringing, _RC) ! skip alarms with zero ringing interval if (ringInterval == zero) cycle @@ -2140,21 +1942,17 @@ subroutine ESMFL_ClockSet(clock, currTime, rc) _ASSERT(mod(delt,ringInterval) == zero, 'Time-shift should be a multiple of ringing interval.') ringTime=ringTime + delt - call ESMF_AlarmSet(alarmList(I), ringTime=ringTime, ringing=ringing, rc=status) - _VERIFY(STATUS) + call ESMF_AlarmSet(alarmList(I), ringTime=ringTime, ringing=ringing, _RC) END DO ! Protection in case we reset the clock outside of StopTime - call ESMF_ClockStopTimeDisable(clock, rc=status) - _VERIFY(STATUS) + call ESMF_ClockStopTimeDisable(clock, _RC) - call ESMF_ClockSet(clock, currTime=targetTime, rc=status) - _VERIFY(STATUS) + call ESMF_ClockSet(clock, currTime=targetTime, _RC) ! We do not need the protection anymore - call ESMF_ClockStopTimeEnable(clock, rc=status) - _VERIFY(STATUS) + call ESMF_ClockStopTimeEnable(clock, _RC) ! clean-up deallocate(alarmList) diff --git a/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 b/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 index baf74b993de5..7fdd7d8c9a71 100644 --- a/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 +++ b/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 @@ -148,7 +148,6 @@ subroutine initialize_p0(model, import_state, export_state, clock, rc) _VERIFY(status) !call MPI_Comm_dup(mpi_comm, dup_comm, status) - !_VERIFY(status) dup_comm = mpi_comm cap_params = get_cap_parameters_from_gc(model, status) diff --git a/gridcomps/ExtData/CMakeLists.txt b/gridcomps/ExtData/CMakeLists.txt index 51ccf7a3a3be..cbc46e446070 100644 --- a/gridcomps/ExtData/CMakeLists.txt +++ b/gridcomps/ExtData/CMakeLists.txt @@ -9,12 +9,8 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic MAPL.pfio MAPL.griddedio MAPL_cfio_r4 TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran) + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index 52f6507fe5ae..9f4d4dbc6dbe 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -20,6 +20,8 @@ set (srcs ExtData_IOBundleMod.F90 ExtData_IOBundleVectorMod.F90 ExtDataMasking.F90 + ExtDataPrimaryExportVector.F90 + ExtDataDerivedExportVector.F90 ) diff --git a/gridcomps/ExtData2G/ExtDataDerivedExportVector.F90 b/gridcomps/ExtData2G/ExtDataDerivedExportVector.F90 new file mode 100644 index 000000000000..d7be690c30a4 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataDerivedExportVector.F90 @@ -0,0 +1,13 @@ +module MAPL_ExtDataDerivedExportVectorMod + use MAPL_ExtDataTypeDef +#define T DerivedExport +#define Vector DerivedExportVector +#define VectorIterator DerivedExportVectorIterator + +#include "vector/template.inc" + +#undef T +#undef Vector +#undef VectorIterator + +end module MAPL_ExtDataDerivedExportVectorMod diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 44877d8f1552..2561c0dd855a 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -62,6 +62,9 @@ MODULE MAPL_ExtDataGridComp2G use MAPL_ExtDataLogger use MAPL_ExtDataConstants use gFTL_StringIntegerMap + use MAPL_FieldUtils + use MAPL_ExtDataPrimaryExportVectorMod + use MAPL_ExtDataDerivedExportVectorMod IMPLICIT NONE PRIVATE @@ -78,20 +81,18 @@ MODULE MAPL_ExtDataGridComp2G type PrimaryExports PRIVATE - integer :: nItems = 0 type(integerVector) :: export_id_start type(integerVector) :: number_of_rules type(stringVector) :: import_names - type(PrimaryExport), pointer :: item(:) => null() + type(PrimaryExportVector) :: item_vec contains procedure :: get_item_index end type PrimaryExports type DerivedExports PRIVATE - integer :: nItems = 0 type(stringVector) :: import_names - type(DerivedExport), pointer :: item(:) => null() + type(DerivedExportVector) :: item_vec end type DerivedExports ! Legacy state @@ -147,8 +148,7 @@ SUBROUTINE SetServices ( GC, RC ) ! Wrap internal state for storing in GC; rename legacyState ! ------------------------------------- - allocate ( self, stat=STATUS ) - _VERIFY(STATUS) + allocate ( self, _STAT ) wrap%ptr => self ! ------------------------ @@ -164,48 +164,27 @@ SUBROUTINE SetServices ( GC, RC ) ! Store internal state in GC ! -------------------------- call ESMF_UserCompSetInternalState ( GC, 'MAPL_ExtData_state', wrap, STATUS ) - _VERIFY(STATUS) - - call MAPL_TimerAdd(gc,name="Initialize", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="Run", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="-Read_Loop", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--CheckUpd", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--Read", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--GridCreate", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--IclientWait", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--PRead", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="---CreateCFIO", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="---prefetch", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----add-collection", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----make-reference", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----RegridStore", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----request", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="---IclientDone", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----RegridApply", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="---read-prefetch", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--Swap", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--Bracket", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="-Interpolate", rc=status) - _VERIFY(STATUS) + + call MAPL_TimerAdd(gc,name="Initialize", _RC) + call MAPL_TimerAdd(gc,name="Run", _RC) + call MAPL_TimerAdd(gc,name="-Read_Loop", _RC) + call MAPL_TimerAdd(gc,name="--CheckUpd", _RC) + call MAPL_TimerAdd(gc,name="--Read", _RC) + call MAPL_TimerAdd(gc,name="--GridCreate", _RC) + call MAPL_TimerAdd(gc,name="--IclientWait", _RC) + call MAPL_TimerAdd(gc,name="--PRead", _RC) + call MAPL_TimerAdd(gc,name="---CreateCFIO", _RC) + call MAPL_TimerAdd(gc,name="---prefetch", _RC) + call MAPL_TimerAdd(gc,name="----add-collection", _RC) + call MAPL_TimerAdd(gc,name="----make-reference", _RC) + call MAPL_TimerAdd(gc,name="----RegridStore", _RC) + call MAPL_TimerAdd(gc,name="----request", _RC) + call MAPL_TimerAdd(gc,name="---IclientDone", _RC) + call MAPL_TimerAdd(gc,name="----RegridApply", _RC) + call MAPL_TimerAdd(gc,name="---read-prefetch", _RC) + call MAPL_TimerAdd(gc,name="--Swap", _RC) + call MAPL_TimerAdd(gc,name="--Bracket", _RC) + call MAPL_TimerAdd(gc,name="-Interpolate", _RC) ! Generic Set Services ! -------------------- call MAPL_GenericSetServices ( GC, _RC ) @@ -270,6 +249,8 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) character(len=1) :: sidx type(ESMF_VM) :: vm type(ESMF_StateItem_Flag) :: state_item_type + type(PrimaryExport), allocatable :: temp_item + type(DerivedExport), allocatable :: derived_item !class(logger), pointer :: lgr ! Get my name and set-up traceback handle @@ -284,8 +265,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Start Some Timers ! ----------------- - call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + call MAPL_GetObjectFromGC ( gc, MAPLSTATE, _RC) call MAPL_TimerOn(MAPLSTATE,"TOTAL") call MAPL_TimerOn(MAPLSTATE,"Initialize") @@ -295,8 +275,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_ClockGet(CLOCK, currTIME=time, _RC) ! Get information from export state !---------------------------------- - call ESMF_StateGet(EXPORT, ITEMCOUNT=ItemCount, RC=STATUS) - _VERIFY(STATUS) + call ESMF_StateGet(EXPORT, ITEMCOUNT=ItemCount, _RC) ! no need to run ExtData if there are no imports to fill if (ItemCount == 0) then @@ -311,14 +290,10 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call new_ExtDataOldTypesCreator(config_yaml, new_rc_file, time, _RC) - allocate(ITEMNAMES(ITEMCOUNT), STAT=STATUS) - _VERIFY(STATUS) - allocate(ITEMTYPES(ITEMCOUNT), STAT=STATUS) - _VERIFY(STATUS) + allocate(ITEMNAMES(ITEMCOUNT), _STAT) + allocate(ITEMTYPES(ITEMCOUNT), _STAT) - call ESMF_StateGet(EXPORT, ITEMNAMELIST=ITEMNAMES, & - ITEMTYPELIST=ITEMTYPES, RC=STATUS) - _VERIFY(STATUS) + call ESMF_StateGet(EXPORT, ITEMNAMELIST=ITEMNAMES, ITEMTYPELIST=ITEMTYPES, _RC) ! -------- ! Initialize MAPL Generic @@ -334,8 +309,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primaryitemcount=0 deriveditemcount=0 do i=1,size(itemnames) - item_type = config_yaml%get_item_type(trim(itemnames(i)),rc=status) - _VERIFY(status) + item_type = config_yaml%get_item_type(trim(itemnames(i)), _RC) found_in_config = (item_type/= ExtData_not_found) if (.not.found_in_config) call unsatisfied_imports%push_back(itemnames(i)) if (item_type == derived_type) then @@ -368,11 +342,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _FAIL("Unsatisfied imports in ExtData") end if - allocate(self%primary%item(PrimaryItemCount),__STAT__) - allocate(self%derived%item(DerivedItemCount),__STAT__) - self%primary%nitems = PrimaryItemCount - self%derived%nitems = DerivedItemCount - num_primary=0 num_derived=0 do i=1,self%primary%import_names%size() @@ -388,15 +357,21 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do j=1,num_rules num_primary=num_primary+1 write(sidx,'(I1)')j - call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,self%primary%item(num_primary),time,clock,rc=status) + allocate(temp_item) + call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,temp_item,time,clock,_RC) _ASSERT(status==0, "ExtData multi-rule problem with BASE NAME "//TRIM(current_base_name)) - allocate(self%primary%item(num_primary)%start_end_time(2)) - self%primary%item(num_primary)%start_end_time(1)=time_ranges(j) - self%primary%item(num_primary)%start_end_time(2)=time_ranges(j+1) + allocate(temp_item%start_end_time(2)) + temp_item%start_end_time(1)=time_ranges(j) + temp_item%start_end_time(2)=time_ranges(j+1) + call self%primary%item_vec%push_back(temp_item) + deallocate(temp_item) enddo else num_primary=num_primary+1 - call config_yaml%fillin_primary(current_base_name,current_base_name,self%primary%item(num_primary),time,clock,rc=status) + allocate(temp_item) + call config_yaml%fillin_primary(current_base_name,current_base_name,temp_item,time,clock,_RC) + call self%primary%item_vec%push_back(temp_item) + deallocate(temp_item) _ASSERT(status==0, "ExtData single-rule problem with BASE NAME "//TRIM(current_base_name)) end if call ESMF_StateGet(Export,current_base_name,state_item_type,_RC) @@ -405,7 +380,8 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_StateAdd(self%ExtDataState,field,_RC) item_type = config_yaml%get_item_type(current_base_name) if (item_type == Primary_Type_Vector_comp1) then - call ESMF_StateGet(Export,self%primary%item(num_primary)%vcomp2,field,_RC) + item => self%primary%item_vec%at(num_primary) + call ESMF_StateGet(Export,item%vcomp2,field,_RC) call MAPL_StateAdd(self%ExtDataState,field,_RC) end if end if @@ -413,16 +389,21 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do i=1,self%derived%import_names%size() current_base_name => self%derived%import_names%at(i) num_derived=num_derived+1 - call config_yaml%fillin_derived(current_base_name,self%derived%item(num_derived),time,clock,_RC) + allocate(derived_item) + call config_yaml%fillin_derived(current_base_name,derived_item,time,clock,_RC) + call self%derived%item_vec%push_back(derived_item) call ESMF_StateGet(Export,current_base_name,field,_RC) call MAPL_StateAdd(self%ExtDataState,field,_RC) + deallocate(derived_item) enddo + ! now see if we have to allocate any primary fields due to a derived item + ! also see if we have to allocate any primary fields due to PS PrimaryLoop: do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) idx = self%primary%get_item_index(current_base_name,time,_RC) - item => self%primary%item(idx) + item => self%primary%item_vec%at(idx) item%pfioCOllection_id = MAPL_DataAddCollection(item%file_template) call create_primary_field(item,self%ExtDataState,time,_RC) @@ -439,7 +420,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !end if !enddo !_ASSERT(idx/=-1,'Surface pressure not present for vertical interpolation') - !self%primary%item(idx)%units = ESMF_UtilStringUppercase(self%primary%item(idx)%units,rc=status) + !self%primary%item(idx)%units = ESMF_UtilStringUppercase(self%primary%item(idx)%units,_RC) !_ASSERT(trim(self%primary%item(idx)%units)=="PA",'PS must be in units of PA') !end if @@ -533,8 +514,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _RETURN(ESMF_SUCCESS) end if - call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + call MAPL_GetObjectFromGC ( gc, MAPLSTATE, _RC) call MAPL_TimerOn(MAPLSTATE,"TOTAL") call MAPL_TimerOn(MAPLSTATE,"Run") @@ -543,11 +523,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Fill in the internal state with data from the files ! --------------------------------------------------- - allocate(do_pointer_update(self%primary%nitems),stat=status) - _VERIFY(STATUS) + allocate(do_pointer_update(self%primary%item_vec%size()),_STAT) do_pointer_update = .false. - allocate(useTime(self%primary%nitems),stat=status) - _VERIFY(STATUS) + allocate(useTime(self%primary%item_vec%size()),_STAT) call MAPL_TimerOn(MAPLSTATE,"-Read_Loop") @@ -558,7 +536,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) current_base_name => self%primary%import_names%at(i) idx = self%primary%get_item_index(current_base_name,current_time,_RC) - item => self%primary%item(idx) + item => self%primary%item_vec%at(idx) if (.not.item%initialized) then item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) @@ -605,38 +583,31 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) bracket_side = io_bundle%bracket_side entry_num = io_bundle%entry_index file_Processed = io_bundle%file_name - item => self%primary%item(entry_num) + item => self%primary%item_vec%at(entry_num) - io_bundle%pbundle = ESMF_FieldBundleCreate(rc=status) - _VERIFY(STATUS) + io_bundle%pbundle = ESMF_FieldBundleCreate(_RC) - call MAPL_ExtDataPopulateBundle(item,bracket_side,io_bundle%pbundle,rc=status) - _VERIFY(status) + call MAPL_ExtDataPopulateBundle(item,bracket_side,io_bundle%pbundle,_RC) call bundle_iter%next() enddo call MAPL_TimerOn(MAPLSTATE,"--PRead") call MAPL_TimerOn(MAPLSTATE,"---CreateCFIO") - call MAPL_ExtDataCreateCFIO(IOBundles, rc=status) - _VERIFY(status) + call MAPL_ExtDataCreateCFIO(IOBundles, _RC) call MAPL_TimerOff(MAPLSTATE,"---CreateCFIO") call MAPL_TimerOn(MAPLSTATE,"---prefetch") - call MAPL_ExtDataPrefetch(IOBundles, file_weights=self%file_weights, rc=status) - _VERIFY(status) + call MAPL_ExtDataPrefetch(IOBundles, file_weights=self%file_weights, _RC) call MAPL_TimerOff(MAPLSTATE,"---prefetch") - _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"---IclientDone") call i_Clients%done_collective_prefetch() call i_Clients%wait() call MAPL_TimerOff(MAPLSTATE,"---IclientDone") - _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"---read-prefetch") - call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) - _VERIFY(status) + call MAPL_ExtDataReadPrefetch(IOBundles,_RC) call MAPL_TimerOff(MAPLSTATE,"---read-prefetch") call MAPL_TimerOff(MAPLSTATE,"--PRead") @@ -645,13 +616,11 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) io_bundle => bundle_iter%get() bracket_side = io_bundle%bracket_side entry_num = io_bundle%entry_index - item => self%primary%item(entry_num) - call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,current_time,rc=status) - _VERIFY(status) + item => self%primary%item_vec%at(entry_num) + call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,current_time,_RC) call bundle_iter%next() enddo - call MAPL_ExtDataDestroyCFIO(IOBundles,rc=status) - _VERIFY(status) + call MAPL_ExtDataDestroyCFIO(IOBundles,_RC) call MAPL_TimerOff(MAPLSTATE,"-Read_Loop") @@ -663,7 +632,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) current_base_name => self%primary%import_names%at(i) idx = self%primary%get_item_index(current_base_name,current_time,_RC) - item => self%primary%item(idx) + item => self%primary%item_vec%at(idx) if (do_pointer_update(i)) then @@ -683,9 +652,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"-Interpolate") ! now take care of derived fields - do i=1,self%derived%nItems + do i=1,self%derived%item_vec%size() - derivedItem => self%derived%item(i) + derivedItem => self%derived%item_vec%at(i) call derivedItem%update_freq%check_update(doUpdate_,use_time,current_time,.not.hasRun,_RC) @@ -745,17 +714,6 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! --------------------- call MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, _RC ) -! Extract relevant runtime information -! ------------------------------------ - call extract_ ( GC, self, CF, _RC) - -! Free the memory used to hold the primary export items -! ----------------------------------------------------- - if (associated(self%primary%item)) then - deallocate(self%primary%item) - end if - - ! All done ! -------- _RETURN(ESMF_SUCCESS) @@ -789,7 +747,6 @@ subroutine extract_ ( GC, self, CF, rc) ! Get my internal state ! --------------------- call ESMF_UserCompGetInternalState(gc, 'MAPL_ExtData_state', WRAP, STATUS) - _VERIFY(STATUS) self => wrap%ptr ! Get the configuration @@ -846,7 +803,7 @@ subroutine GetLevs(item, rc) positive=>null() var => null() - if (item%isVector) then + if (item%vartype == MAPL_VectorField) then var=>item%file_metadata%get_variable(trim(item%fcomp1)) _ASSERT(associated(var),"Variable "//TRIM(item%fcomp1)//" not found in file "//TRIM(item%file_template)) var => null() @@ -857,8 +814,7 @@ subroutine GetLevs(item, rc) _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file_template)) end if - levName = item%file_metadata%get_level_name(rc=status) - _VERIFY(status) + levName = item%file_metadata%get_level_name(_RC) if (trim(levName) /='') then call item%file_metadata%get_coordinate_info(levName,coordSize=item%lm,coordUnits=tLevUnits,coords=levFile,_RC) levUnits=MAPL_TrimString(tlevUnits) @@ -884,12 +840,10 @@ subroutine GetLevs(item, rc) enddo end if if (trim(item%levunit)=='hpa') item%levs=item%levs*100.0 - if (item%isVector) then - item%units = item%file_metadata%get_variable_attribute(trim(item%fcomp1),"units",rc=status) - _VERIFY(status) + if (item%vartype == MAPL_VectorField) then + item%units = item%file_metadata%get_variable_attribute(trim(item%fcomp1),"units",_RC) else - item%units = item%file_metadata%get_variable_attribute(trim(item%var),"units",rc=status) - _VERIFY(status) + item%units = item%file_metadata%get_variable_attribute(trim(item%var),"units",_RC) end if else @@ -928,69 +882,50 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) integer :: status integer :: id_ps type(ESMF_Field) :: field, newfield,psF + type(PrimaryExport), pointer :: ps_item if (item%do_VertInterp) then if (trim(item%importVDir)/=trim(item%fileVDir)) then - call MAPL_ExtDataFlipVertical(item,filec,rc=status) - _VERIFY(status) + call MAPL_ExtDataFlipVertical(item,filec,_RC) end if if (item%vartype == MAPL_fieldItem) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) - _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,_RC) id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) - call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) - _VERIFY(STATUS) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) - _VERIFY(STATUS) + ps_item => ExtState%primary%item_vec%at(id_ps) + call MAPL_ExtDataGetBracket(ps_item,filec,field=psF,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) else if (item%vartype == MAPL_VectorField) then id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) - call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,rc=status) - _VERIFY(STATUS) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,rc=status) - _VERIFY(STATUS) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) - _VERIFY(STATUS) + ps_item => ExtState%primary%item_vec%at(id_ps) + call MAPL_ExtDataGetBracket(ps_item,filec,field=psF,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) end if else if (item%do_Fill) then if (item%vartype == MAPL_fieldItem) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataFillField(item,field,newfield,rc=status) - _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) else if (item%vartype == MAPL_VectorField) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataFillField(item,field,newfield,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataFillField(item,field,newfield,rc=status) - _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) end if else if (trim(item%importVDir)/=trim(item%fileVDir)) then - call MAPL_ExtDataFlipVertical(item,filec,rc=status) - _VERIFY(status) + call MAPL_ExtDataFlipVertical(item,filec,_RC) end if end if @@ -1022,72 +957,47 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) call ESMF_ConfigGetAttribute(CF, value = NY, Label="NY:", _RC) comp_name = "ExtData" - cflocal = MAPL_ConfigCreate(rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=NX, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NX:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=lm, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"LM:",rc=status) - _VERIFY(status) + cflocal = MAPL_ConfigCreate(_RC) + call MAPL_ConfigSetAttribute(cflocal,value=NX, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NX:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=lm, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"LM:",_RC) if (counts(2) == 6*counts(1)) then - call MAPL_ConfigSetAttribute(cflocal,value="Cubed-Sphere", label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRID_TYPE:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NF:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=ny/6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) - _VERIFY(status) - - call ESMF_InfoGetFromHost(grid,infoh,rc=status) - _VERIFY(status) - isPresent = ESMF_InfoIsPresent(infoh,'STRETCH_FACTOR',rc=status) - _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value="Cubed-Sphere", label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRID_TYPE:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NF:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=ny/6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",_RC) + + call ESMF_InfoGetFromHost(grid,infoh,_RC) if (isPresent) then - call ESMF_InfoGet(infoh,'STRETCH_FACTOR',temp_real,rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",rc=status) - _VERIFY(status) + call ESMF_InfoGet(infoh,'STRETCH_FACTOR',temp_real,_RC) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",_RC) endif - isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LON',rc=status) - _VERIFY(status) + isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LON',_RC) if (isPresent) then - call ESMF_InfoGet(infoh,'TARGET_LON',temp_real,rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LON:",rc=status) - _VERIFY(status) + call ESMF_InfoGet(infoh,'TARGET_LON',temp_real,_RC) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LON:",_RC) endif - isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LAT',rc=status) - _VERIFY(status) + isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LAT',_RC) if (isPresent) then - call ESMF_InfoGet(infoh,'TARGET_LAT',temp_real,rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LAT:",rc=status) - _VERIFY(status) + call ESMF_InfoGet(infoh,'TARGET_LAT',temp_real,_RC) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LAT:",_RC) endif else - call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=counts(2), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"JM_WORLD:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=ny, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) - _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=counts(2), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"JM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=ny, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",_RC) end if - newgrid = grid_manager%make_grid(cflocal, prefix=trim(COMP_Name)//".", rc=status) - _VERIFY(status) + newgrid = grid_manager%make_grid(cflocal, prefix=trim(COMP_Name)//".", _RC) _RETURN(ESMF_SUCCESS) end function MAPL_ExtDataGridChangeLev subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) - type(PrimaryExport), intent(inout) :: item integer, intent(in ) :: bside type(ESMF_Field), optional, intent(inout) :: field @@ -1196,10 +1106,8 @@ subroutine MAPL_ExtDataFillField(item,FieldF,FieldR,rc) real, pointer :: ptrF(:,:,:),ptrR(:,:,:) integer :: lm_in,lm_out,i - call ESMF_FieldGet(FieldF,0,farrayPtr=ptrF,rc=status) - _VERIFY(STATUS) - call ESMF_FieldGet(FieldR,0,farrayPtr=ptrR,rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(FieldF,0,farrayPtr=ptrF,_RC) + call ESMF_FieldGet(FieldR,0,farrayPtr=ptrR,_RC) ptrF = 0.0 lm_in= size(ptrR,3) lm_out = size(ptrF,3) @@ -1242,26 +1150,18 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) real, allocatable :: ptemp(:,:,:) integer :: ls, le - if (item%isVector) then + if (item%vartype == MAPL_VectorField) then - if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,_RC) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,_RC) - else - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) - end if + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) - call ESMF_FieldGet(Field1,0,farrayPtr=ptr,rc=status) - _VERIFY(STATUS) - allocate(ptemp,source=ptr,stat=status) - _VERIFY(status) + call ESMF_FieldGet(Field1,0,farrayPtr=ptr,_RC) + allocate(ptemp,source=ptr,_STAT) ls = lbound(ptr,3) le = ubound(ptr,3) ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) - call ESMF_FieldGet(Field2,0,farrayPtr=ptr,rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(Field2,0,farrayPtr=ptr,_RC) ptemp=ptr ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) @@ -1269,16 +1169,10 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) else - if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,_RC) - else - call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) - end if + call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) - call ESMF_FieldGet(Field,0,farrayPtr=ptr,rc=status) - _VERIFY(STATUS) - allocate(ptemp,source=ptr,stat=status) - _VERIFY(status) + call ESMF_FieldGet(Field,0,farrayPtr=ptr,_RC) + allocate(ptemp,source=ptr,_STAT) ls = lbound(ptr,3) le = ubound(ptr,3) ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) @@ -1299,39 +1193,23 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) type(ESMF_Field) :: Field,field1,field2 type(ESMF_Grid) :: grid - if (item%isVector) then + if (item%vartype == MAPL_VectorField) then - if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,_RC) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,_RC) - else - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) - end if + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) - call ESMF_FieldGet(Field1,grid=grid,rc=status) - _VERIFY(STATUS) - call ESMF_FieldBundleSet(pbundle,grid=grid,rc=status) - _VERIFY(STATUS) - call MAPL_FieldBundleAdd(pbundle,Field1,rc=status) - _VERIFY(STATUS) - call MAPL_FieldBundleAdd(pbundle,Field2,rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(Field1,grid=grid,_RC) + call ESMF_FieldBundleSet(pbundle,grid=grid,_RC) + call MAPL_FieldBundleAdd(pbundle,Field1,_RC) + call MAPL_FieldBundleAdd(pbundle,Field2,_RC) else - if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,_RC) - else - call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) - end if + call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) - call ESMF_FieldGet(Field,grid=grid,rc=status) - _VERIFY(STATUS) - call ESMF_FieldBundleSet(pbundle,grid=grid,rc=status) - _VERIFY(STATUS) - call MAPL_FieldBundleAdd(pbundle,Field,rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(Field,grid=grid,_RC) + call ESMF_FieldBundleSet(pbundle,grid=grid,_RC) + call MAPL_FieldBundleAdd(pbundle,Field,_RC) end if @@ -1480,8 +1358,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) if (trim(current_file)/=file_not_found) then call itemsL%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataLeft, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & - item%pfioCollection_id,item%iclient_collection_id,itemsL,on_tiles,rc=status) - _VERIFY(status) + item%pfioCollection_id,item%iclient_collection_id,itemsL,on_tiles,_RC) call IOBundles%push_back(io_bundle) call extdata_lgr%info('%a updated L bracket with: %a at time index %i3 ',item%name, current_file, time_index) end if @@ -1491,8 +1368,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) if (trim(current_file)/=file_not_found) then call itemsR%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataRight, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & - item%pfioCollection_id,item%iclient_collection_id,itemsR,on_tiles,rc=status) - _VERIFY(status) + item%pfioCollection_id,item%iclient_collection_id,itemsR,on_tiles,_RC) call IOBundles%push_back(io_bundle) call extdata_lgr%info('%a updated R bracket with: %a at time index %i3 ',item%name,current_file, time_index) end if @@ -1507,39 +1383,17 @@ subroutine set_constant_field(item,ExtDataState,rc) type(ESMF_State), intent(inout) :: extDataState integer, intent(out), optional :: rc - integer :: status,fieldRank - real(kind=REAL32), pointer :: ptr2d(:,:),ptr3d(:,:,:) + integer :: status type(ESMF_Field) :: field if (item%vartype == MAPL_FieldItem) then call ESMF_StateGet(ExtDataState,trim(item%name),field,_RC) - call ESMF_FieldGet(field,dimCount=fieldRank,_RC) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%name),_RC) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%name), _RC) - ptr3d = item%const - endif + call FieldSet(field, item%const, _RC) else if (item%vartype == MAPL_VectorField) then call ESMF_StateGet(ExtDataState,trim(item%vcomp1),field,_RC) - call ESMF_FieldGet(field,dimCount=fieldRank,_RC) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp1),_RC) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp1), _RC) - ptr3d = item%const - endif - call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,_RC) - call ESMF_FieldGet(field,dimCount=fieldRank,_RC) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp2),_RC) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp2), _RC) - ptr3d = item%const - endif + call FieldSet(field, item%const, _RC) + call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,_RC) + call FieldSet(field, item%const, _RC) end if _RETURN(_SUCCESS) @@ -1680,7 +1534,7 @@ subroutine create_primary_field(item,ExtDataState,current_time,rc) logical :: file_found call ESMF_StateGet(ExtDataState,trim(item%name),field,_RC) - call ESMF_FieldValidate(field,rc=status) + call ESMF_FieldValidate(field,_RC) call ESMF_AttributeGet(field,name="derived_source",isPresent=must_create,_RC) if (.not.must_create) then _RETURN(_SUCCESS) @@ -1754,6 +1608,7 @@ function get_item_index(this,base_name,current_time,rc) result(item_index) integer :: i integer, pointer :: num_rules,i_start logical :: found + type(PrimaryExport), pointer :: item found = .false. do i=1,this%import_names%size() @@ -1772,8 +1627,9 @@ function get_item_index(this,base_name,current_time,rc) result(item_index) item_index = i_start else if (num_rules > 1) then do i=1,num_rules - if (current_time >= this%item(i_start+i-1)%start_end_time(1) .and. & - current_time < this%item(i_start+i-1)%start_end_time(2)) then + item => this%item_vec%at(i_start+i-1) + if (current_time >= item%start_end_time(1) .and. & + current_time < item%start_end_time(2)) then item_index = i_start + i -1 exit endif diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index af453e701f5b..73015ec07363 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -82,13 +82,10 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa call default_time_sample%set_defaults() time_sample=>default_time_sample end if - primary_item%isVector = allocated(rule%vector_partner) - ! name and file var - !primary_item%name = trim(item_name) + primary_item%vartype = MAPL_FieldItem + if (allocated(rule%vector_partner)) primary_item%vartype = MAPL_VectorField primary_item%name = trim(base_name) - if (primary_item%isVector) then - primary_item%vartype = MAPL_VectorField - !primary_item%vcomp1 = trim(item_name) + if (primary_item%vartype == MAPL_VectorField) then primary_item%vcomp1 = trim(base_name) primary_item%vcomp2 = trim(rule%vector_partner) primary_item%var = rule%file_var @@ -98,8 +95,6 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa primary_item%fileVars%xname = trim(rule%file_var) primary_item%fileVars%yname = trim(rule%vector_file_partner) else - primary_item%vartype = MAPL_FieldItem - !primary_item%vcomp1 = trim(item_name) primary_item%vcomp1 = trim(base_name) primary_item%var = rule%file_var primary_item%fcomp1 = rule%file_var @@ -136,8 +131,6 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa call primary_item%modelGridFields%comp1%set_parameters(linear_trans=rule%linear_trans,disable_interpolation=disable_interpolation,exact=exact) call primary_item%modelGridFields%comp2%set_parameters(linear_trans=rule%linear_trans,disable_interpolation=disable_interpolation,exact=exact) - call primary_item%modelGridFields%auxiliary1%set_parameters(linear_trans=rule%linear_trans, disable_interpolation=disable_interpolation,exact=exact) - call primary_item%modelGridFields%auxiliary2%set_parameters(linear_trans=rule%linear_trans, disable_interpolation=disable_interpolation,exact=exact) ! file_template primary_item%isConst = .false. diff --git a/gridcomps/ExtData2G/ExtDataPrimaryExportVector.F90 b/gridcomps/ExtData2G/ExtDataPrimaryExportVector.F90 new file mode 100644 index 000000000000..b6eb6aaed9a7 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataPrimaryExportVector.F90 @@ -0,0 +1,13 @@ +module MAPL_ExtDataPrimaryExportVectorMod + use MAPL_ExtDataTypeDef +#define T PrimaryExport +#define Vector PrimaryExportVector +#define VectorIterator PrimaryExportVectorIterator + +#include "vector/template.inc" + +#undef T +#undef Vector +#undef VectorIterator + +end module MAPL_ExtDataPrimaryExportVectorMod diff --git a/gridcomps/History/CMakeLists.txt b/gridcomps/History/CMakeLists.txt index 58af30a30b27..e470a5dddca2 100644 --- a/gridcomps/History/CMakeLists.txt +++ b/gridcomps/History/CMakeLists.txt @@ -14,12 +14,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic MAPL.profiler MAPL.griddedio TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index c287dae7b07d..7aa0afff2a1c 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -425,6 +425,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) logical :: has_conservative_keyword, has_regrid_keyword integer :: create_mode character(len=:), allocatable :: uppercase_algorithm + character(len=2) :: tmpchar ! Begin !------ @@ -838,40 +839,51 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute ( cfg, list(n)%quantize_algorithm_string, default='NONE', & label=trim(string) // 'quantize_algorithm:' ,_RC ) + call ESMF_ConfigGetAttribute ( cfg, list(n)%quantize_level, default=0, & + label=trim(string) // 'quantize_level:' ,_RC ) + ! Uppercase the algorithm string just to allow for any case + ! CF Conventions will prefer 'bitgroom', 'bitround', and 'granular_bitround' + ! but we will allow 'GranularBR' in MAPL2, deprecate it, and remove it in MAPL3 uppercase_algorithm = ESMF_UtilStringUpperCase(list(n)%quantize_algorithm_string,_RC) select case (trim(uppercase_algorithm)) case ('NONE') - list(n)%quantize_algorithm = MAPL_Quantize_Disabled + list(n)%quantize_algorithm = MAPL_NOQUANTIZE + ! If quantize_algorithm is 0, then quantize_level must be 0 + _ASSERT( list(n)%quantize_level == 0, 'quantize_algorithm is none, so quantize_level must be "none"') case ('BITGROOM') - list(n)%quantize_algorithm = MAPL_Quantize_BitGroom - case ('GRANULARBR') - list(n)%quantize_algorithm = MAPL_Quantize_GranularBR + list(n)%quantize_algorithm = MAPL_QUANTIZE_BITGROOM + case ('GRANULARBR', 'GRANULAR_BITROUND') + list(n)%quantize_algorithm = MAPL_QUANTIZE_GRANULAR_BITROUND case ('BITROUND') - list(n)%quantize_algorithm = MAPL_Quantize_BitRound + list(n)%quantize_algorithm = MAPL_QUANTIZE_BITROUND case default - _FAIL('Invalid quantize_algorithm. Allowed values are NONE, BitGroom, GranularBR, BitRound') + _FAIL('Invalid quantize_algorithm. Allowed values are none, bitgroom, granular_bitround, granularbr (deprecated), and bitround') end select - call ESMF_ConfigGetAttribute ( cfg, list(n)%quantize_level, default=0, & - label=trim(string) // 'quantize_level:' ,_RC ) - ! If nbits_to_keep < MAPL_NBITS_UPPER_LIMIT (24) and quantize_algorithm greater than 0, then a user might be doing different ! shaving algorithms. We do not allow this - _ASSERT( .not. ( (list(n)%nbits_to_keep < MAPL_NBITS_UPPER_LIMIT) .and. (list(n)%quantize_algorithm > 0) ), 'nbits < 24 and quantize_algorithm > 0 is not allowed. Choose one bit grooming method.') - - ! quantize_algorithm must be between 0 and 3 where 0 means not enabled - _ASSERT( (list(n)%quantize_algorithm >= 0) .and. (list(n)%quantize_algorithm <= 3), 'quantize_algorithm must be between 0 and 3, where 0 means not enabled') + _ASSERT( .not. ( (list(n)%nbits_to_keep < MAPL_NBITS_UPPER_LIMIT) .and. (list(n)%quantize_algorithm > MAPL_NOQUANTIZE) ), 'nbits < 24 and quantize_algorithm not "none" is not allowed. Choose a supported quantization method.') ! Now we test in the case that a valid quantize algorithm is chosen - if (list(n)%quantize_algorithm == 0) then - ! If quantize_algorithm is 0, then quantize_level must be 0 - _ASSERT( list(n)%quantize_level == 0, 'quantize_algorithm is 0, so quantize_level must be 0') - else + if (list(n)%quantize_algorithm /= MAPL_NOQUANTIZE) then ! If quantize_algorithm is greater than 0, then quantize_level must be greater than or equal to 0 _ASSERT( list(n)%quantize_level >= 0, 'netCDF quantize has been enabled, so quantize_level must be greater than or equal to 0') end if + ! If a user has chosen MAPL_QUANTIZE_BITROUND, then we allow a maximum of 23 bits to be kept + if (list(n)%quantize_algorithm == MAPL_QUANTIZE_BITROUND) then + write(tmpchar, '(I2)') MAPL_QUANTIZE_MAX_NSB + _ASSERT( list(n)%quantize_level <= MAPL_QUANTIZE_MAX_NSB, 'netCDF bitround has been enabled, so number of significant bits (quantize_level) must be less than or equal to ' // trim(tmpchar)) + end if + + ! For MAPL_QUANTIZE_GRANULAR_BITROUND and MAPL_QUANTIZE_BITGROOM, these use number of + ! significant digits, so for single precision, we allow a maximum of 7 digits to be kept + if (list(n)%quantize_algorithm == MAPL_QUANTIZE_GRANULAR_BITROUND .or. list(n)%quantize_algorithm == MAPL_QUANTIZE_BITGROOM) then + write(tmpchar, '(I2)') MAPL_QUANTIZE_MAX_NSD + _ASSERT( list(n)%quantize_level <= MAPL_QUANTIZE_MAX_NSD, 'netCDF granular bitround or bitgroom has been enabled, so number of significant digits (quantize_level) must be less than or equal to ' // trim(tmpchar)) + end if + tm_default = -1 call ESMF_ConfigGetAttribute ( cfg, list(n)%tm, default=tm_default, & label=trim(string) // 'tm:', _RC ) @@ -2426,8 +2438,10 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call list(n)%trajectory%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) IntState%stampoffset(n) = list(n)%trajectory%epoch_frequency elseif (list(n)%sampler_spec == 'mask') then + call MAPL_TimerOn(GENSTATE,"mask_init") list(n)%mask_sampler = MaskSamplerGeosat(cfg,string,clock,genstate=GENSTATE,_RC) call list(n)%mask_sampler%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) + call MAPL_TimerOff(GENSTATE,"mask_init") elseif (list(n)%sampler_spec == 'station') then list(n)%station_sampler = StationSampler (list(n)%bundle, trim(list(n)%stationIdFile), nskip_line=list(n)%stationSkipLine, genstate=GENSTATE, _RC) call list(n)%station_sampler%add_metadata_route_handle(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) @@ -3706,11 +3720,9 @@ subroutine Run ( gc, import, export, clock, rc ) call MAPL_TimerOff(GENSTATE,"Station") elseif (list(n)%sampler_spec == 'mask') then call ESMF_ClockGet(clock,currTime=current_time,_RC) - call MAPL_TimerOn(GENSTATE,"Mask") - call MAPL_TimerOn(GENSTATE,"AppendFile") + call MAPL_TimerOn(GENSTATE,"Mask_append") call list(n)%mask_sampler%append_file(current_time,_RC) - call MAPL_TimerOff(GENSTATE,"AppendFile") - call MAPL_TimerOff(GENSTATE,"Mask") + call MAPL_TimerOff(GENSTATE,"Mask_append") endif diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 index 21e9d1251379..3d9563e976e2 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 @@ -21,6 +21,7 @@ module MaskSamplerGeosatMod use pFIO_FileMetadataMod, only : FileMetadata use pFIO_NetCDF4_FileFormatterMod, only : NetCDF4_FileFormatter use MAPL_GenericMod, only : MAPL_MetaComp, MAPL_TimerOn, MAPL_TimerOff + use MPI, only : MPI_INTEGER, MPI_REAL, MPI_REAL8 use, intrinsic :: iso_fortran_env, only: REAL32 use, intrinsic :: iso_fortran_env, only: REAL64 use pflogger, only: Logger, logging diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index f19e204d9c04..8461b9060a87 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -35,7 +35,7 @@ module function MaskSamplerGeosat_from_config(config,string,clock,GENSTATE,rc) r mask%clock=clock mask%grid_file_name='' if (present(GENSTATE)) mask%GENSTATE => GENSTATE - + call ESMF_ClockGet ( clock, CurrTime=currTime, _RC ) if (mapl_am_I_root()) write(6,*) 'string', string @@ -159,13 +159,13 @@ module subroutine create_Geosat_grid_find_mask(this, rc) integer, optional, intent(out) :: rc type(Logger), pointer :: lgr - real(ESMF_KIND_R8), pointer :: ptAT(:) type(ESMF_routehandle) :: RH type(ESMF_Grid) :: grid - integer :: mypet, npes + integer :: mypet, petcount, mpic integer :: iroot, rootpet, ierr type (ESMF_LocStream) :: LS_rt type (ESMF_LocStream) :: LS_ds + type (ESMF_LocStream) :: LS_chunk type (LocStreamFactory):: locstream_factory type (ESMF_Field) :: fieldA type (ESMF_Field) :: fieldB @@ -182,13 +182,11 @@ module subroutine create_Geosat_grid_find_mask(this, rc) type(ESMF_DElayout) :: layout type(ESMF_VM) :: VM integer :: myid - integer :: ndes integer :: dimCount integer, allocatable :: II(:) integer, allocatable :: JJ(:) real(REAL64), allocatable :: obs_lons(:) real(REAL64), allocatable :: obs_lats(:) - integer :: mpic type (ESMF_Field) :: fieldI4 type(ESMF_routehandle) :: RH_halo @@ -227,17 +225,34 @@ module subroutine create_Geosat_grid_find_mask(this, rc) integer :: nsend integer, allocatable :: recvcounts_loc(:) integer, allocatable :: displs_loc(:) - integer :: status + + integer, allocatable :: sendcount(:), displs(:) + integer :: recvcount + integer :: M, N, ip + integer :: nx2 + + real(REAL64), allocatable :: lons_chunk(:) + real(REAL64), allocatable :: lats_chunk(:) + + integer :: status, imethod + lgr => logging%get_logger('HISTORY.sampler') ! Metacode: - ! read ABI grid into LS_rt - ! gen LS_ds with CS background grid + ! read ABI grid into lons/lats, lons_chunk/lats_chunk + ! gen LS_chunk and LS_ds with CS background grid ! find mask points on each PET with halo ! prepare recvcounts + displs for gatherv ! + call ESMF_VMGetCurrent(vm,_RC) + call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=petcount, localpet=mypet, _RC) + iroot = 0 + ip = mypet ! 0 to M-1 + M = petCount + + call MAPL_TimerOn(this%GENSTATE,"1_genABIgrid") if (mapl_am_i_root()) then ! __s1. SAT file ! @@ -247,100 +262,159 @@ module subroutine create_Geosat_grid_find_mask(this, rc) key_p = this%var_name_proj key_p_att = this%att_name_proj call get_ncfile_dimension(fn,nlon=n1,nlat=n2,key_lon=key_x,key_lat=key_y,_RC) - ! - ! use thin_factor to reduce regridding matrix size - ! - xdim_true = n1 - ydim_true = n2 - xdim_red = n1 / this%thin_factor - ydim_red = n2 / this%thin_factor - allocate (x (xdim_true), _STAT ) - allocate (y (xdim_true), _STAT ) - + allocate (x(n1), y(n2), _STAT) call get_v1d_netcdf_R8_complete (fn, key_x, x, _RC) call get_v1d_netcdf_R8_complete (fn, key_y, y, _RC) call get_att_real_netcdf (fn, key_p, key_p_att, lambda0_deg, _RC) lam_sat = lambda0_deg * MAPL_DEGREES_TO_RADIANS_R8 + end if + call MAPL_CommsBcast(vm, DATA=n1, N=1, ROOT=MAPL_Root, _RC) + call MAPL_CommsBcast(vm, DATA=n2, N=1, ROOT=MAPL_Root, _RC) + if ( .NOT. mapl_am_i_root() ) allocate (x(n1), y(n2), _STAT) + call MAPL_CommsBcast(vm, DATA=lam_sat, N=1, ROOT=MAPL_Root, _RC) + call MAPL_CommsBcast(vm, DATA=x, N=n1, ROOT=MAPL_Root, _RC) + call MAPL_CommsBcast(vm, DATA=y, N=n2, ROOT=MAPL_Root, _RC) + + ! + ! use thin_factor to reduce regridding matrix size + ! + xdim_red = n1 / this%thin_factor + ydim_red = n2 / this%thin_factor + _ASSERT ( xdim_red * ydim_red > M, 'mask reduced points after thin_factor is less than Nproc!') - nx=0 - do i=1, xdim_red - do j=1, ydim_red + ! get nx2 + nx2=0 + k=0 + do i=1, xdim_red + do j=1, ydim_red + k = k + 1 + if ( mod(k,M) == ip ) then x0 = x( i * this%thin_factor ) y0 = y( j * this%thin_factor ) call ABI_XY_2_lonlat (x0, y0, lam_sat, lon0, lat0, mask=mask0) if (mask0 > 0) then - nx=nx+1 + nx2=nx2+1 end if - end do + end if end do - allocate (lons(nx), lats(nx), _STAT) - nx = 0 - do i=1, xdim_red - do j=1, ydim_red + end do + allocate (lons_chunk(nx2), lats_chunk(nx2), _STAT) + + ! get lons_chunk/... + nx2 = 0 + k = 0 + do i=1, xdim_red + do j=1, ydim_red + k = k + 1 + if ( mod(k,M) == ip ) then x0 = x( i * this%thin_factor ) y0 = y( j * this%thin_factor ) call ABI_XY_2_lonlat (x0, y0, lam_sat, lon0, lat0, mask=mask0) if (mask0 > 0) then - nx=nx+1 - lons(nx) = lon0 * MAPL_RADIANS_TO_DEGREES - lats(nx) = lat0 * MAPL_RADIANS_TO_DEGREES + nx2=nx2+1 + lons_chunk(nx2) = lon0 * MAPL_RADIANS_TO_DEGREES + lats_chunk(nx2) = lat0 * MAPL_RADIANS_TO_DEGREES end if - end do + end if end do - arr(1)=nx - else - allocate(lons(0),lats(0),_STAT) - arr(1)=0 - endif + end do - call ESMF_VMGetCurrent(vm,_RC) - call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=npes, localpet=mypet, _RC) + arr(1)=nx2 call ESMF_VMAllFullReduce(vm, sendData=arr, recvData=nx, & count=1, reduceflag=ESMF_REDUCE_SUM, _RC) - this%nobs = nx - if (mapl_am_I_root()) write(6,*) 'nobs tot :', nx - if ( nx == 0 ) then - this%is_valid = .false. - _RETURN(ESMF_SUCCESS) - ! - ! no valid obs points are found - ! + + ! gatherV for lons/lats + if (mapl_am_i_root()) then + allocate(lons(nx),lats(nx),_STAT) + else + allocate(lons(0),lats(0),_STAT) + endif + + allocate( this%recvcounts(petcount), this%displs(petcount), _STAT ) + allocate( recvcounts_loc(petcount), displs_loc(petcount), _STAT ) + recvcounts_loc(:)=1 + displs_loc(1)=0 + do i=2, petcount + displs_loc(i) = displs_loc(i-1) + recvcounts_loc(i-1) + end do + call MPI_gatherv ( nx2, 1, MPI_INTEGER, & + this%recvcounts, recvcounts_loc, displs_loc, MPI_INTEGER,& + iroot, mpic, ierr ) + _VERIFY(ierr) + if (.not. mapl_am_i_root()) then + this%recvcounts(:) = 0 end if + this%displs(1)=0 + do i=2, petcount + this%displs(i) = this%displs(i-1) + this%recvcounts(i-1) + end do + + nsend = nx2 + call MPI_gatherv ( lons_chunk, nsend, MPI_REAL8, & + lons, this%recvcounts, this%displs, MPI_REAL8,& + iroot, mpic, ierr ) + _VERIFY(ierr) + call MPI_gatherv ( lats_chunk, nsend, MPI_REAL8, & + lats, this%recvcounts, this%displs, MPI_REAL8,& + iroot, mpic, ierr ) + _VERIFY(ierr) + + +!! if (mapl_am_I_root()) write(6,*) 'nobs tot :', nx + + deallocate (this%recvcounts, this%displs, _STAT) + deallocate (recvcounts_loc, displs_loc, _STAT) + deallocate (x, y, _STAT) + call MAPL_TimerOff(this%GENSTATE,"1_genABIgrid") ! __ s2. set distributed LS ! + call MAPL_TimerOn(this%GENSTATE,"2_ABIgrid_LS") + + ! -- root locstream_factory = LocStreamFactory(lons,lats,_RC) LS_rt = locstream_factory%create_locstream(_RC) + + ! -- proc + locstream_factory = LocStreamFactory(lons_chunk,lats_chunk,_RC) + LS_chunk = locstream_factory%create_locstream_on_proc(_RC) + + ! -- distributed with background grid call ESMF_FieldBundleGet(this%bundle,grid=grid,_RC) - LS_ds = locstream_factory%create_locstream(grid=grid,_RC) + LS_ds = locstream_factory%create_locstream_on_proc(grid=grid,_RC) - fieldA = ESMF_FieldCreate (LS_rt, name='A', typekind=ESMF_TYPEKIND_R8, _RC) + fieldA = ESMF_FieldCreate (LS_chunk, name='A', typekind=ESMF_TYPEKIND_R8, _RC) fieldB = ESMF_FieldCreate (LS_ds, name='B', typekind=ESMF_TYPEKIND_R8, _RC) - call ESMF_FieldGet( fieldA, localDE=0, farrayPtr=ptA) call ESMF_FieldGet( fieldB, localDE=0, farrayPtr=ptB) - if (mypet == 0) then - ptA(:) = lons(:) - end if + + ptA(:) = lons_chunk(:) call ESMF_FieldRedistStore (fieldA, fieldB, RH, _RC) + call MPI_Barrier(mpic,ierr) + _VERIFY(ierr) call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) lons_ds = ptB - if (mypet == 0) then - ptA(:) = lats(:) - end if + ptA(:) = lats_chunk(:) + call MPI_Barrier(mpic,ierr) + _VERIFY(ierr) call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) lats_ds = ptB - call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) +!! write(6,*) 'ip, size(lons_ds)=', mypet, size(lons_ds) + call ESMF_FieldDestroy(fieldA,nogarbage=.true.,_RC) call ESMF_FieldDestroy(fieldB,nogarbage=.true.,_RC) + call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) + + call MAPL_TimerOff(this%GENSTATE,"2_ABIgrid_LS") ! __ s3. find n.n. CS pts for LS_ds (halo) ! + call MAPL_TimerOn(this%GENSTATE,"3_CS_halo") obs_lons = lons_ds * MAPL_DEGREES_TO_RADIANS_R8 obs_lats = lats_ds * MAPL_DEGREES_TO_RADIANS_R8 nx = size ( lons_ds ) @@ -407,6 +481,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) end if end do end do + call MAPL_TimerOff(this%GENSTATE,"3_CS_halo") ! ---- @@ -415,6 +490,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ! - mpi_gatherV ! + call MAPL_TimerOn(this%GENSTATE,"4_gatherV") ! __ s4.1 find this%lons/lats on root for NC output ! @@ -442,21 +518,22 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ! __ s4.2 find this%recvcounts / this%displs ! - allocate( this%recvcounts(npes), this%displs(npes), _STAT ) - allocate( recvcounts_loc(npes), displs_loc(npes), _STAT ) + allocate( this%recvcounts(petcount), this%displs(petcount), _STAT ) + allocate( recvcounts_loc(petcount), displs_loc(petcount), _STAT ) recvcounts_loc(:)=1 displs_loc(1)=0 - do i=2, npes + do i=2, petcount displs_loc(i) = displs_loc(i-1) + recvcounts_loc(i-1) end do call MPI_gatherv ( this%npt_mask, 1, MPI_INTEGER, & this%recvcounts, recvcounts_loc, displs_loc, MPI_INTEGER,& iroot, mpic, ierr ) + _VERIFY(ierr) if (.not. mapl_am_i_root()) then this%recvcounts(:) = 0 end if this%displs(1)=0 - do i=2, npes + do i=2, petcount this%displs(i) = this%displs(i-1) + this%recvcounts(i-1) end do @@ -467,9 +544,13 @@ module subroutine create_Geosat_grid_find_mask(this, rc) call MPI_gatherv ( lons, nsend, MPI_REAL8, & this%lons, this%recvcounts, this%displs, MPI_REAL8,& iroot, mpic, ierr ) + _VERIFY(ierr) call MPI_gatherv ( lats, nsend, MPI_REAL8, & this%lats, this%recvcounts, this%displs, MPI_REAL8,& iroot, mpic, ierr ) + _VERIFY(ierr) + + call MAPL_TimerOff(this%GENSTATE,"4_gatherV") _RETURN(_SUCCESS) end subroutine create_Geosat_grid_find_mask @@ -589,7 +670,7 @@ module subroutine regrid_append_file(this,current_time,rc) integer :: i, j, k, rank integer :: nx, nz integer :: ix, iy, m - integer :: mypet, npes, nsend + integer :: mypet, petcount, nsend integer :: iroot, ierr integer :: mpic integer, allocatable :: recvcounts_3d(:) @@ -602,7 +683,7 @@ module subroutine regrid_append_file(this,current_time,rc) ! -- fixed for all fields call ESMF_VMGetCurrent(vm,_RC) - call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=npes, localpet=mypet, _RC) + call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=petcount, localpet=mypet, _RC) iroot=0 nx = this%npt_mask nz = this%vdata%lm @@ -615,7 +696,7 @@ module subroutine regrid_append_file(this,current_time,rc) allocate ( p_dst_2d_full (0), _STAT ) allocate ( p_dst_3d_full (0), _STAT ) end if - allocate( recvcounts_3d(npes), displs_3d(npes), _STAT ) + allocate( recvcounts_3d(petcount), displs_3d(petcount), _STAT ) recvcounts_3d(:) = nz * this%recvcounts(:) displs_3d(:) = nz * this%displs(:) @@ -655,7 +736,8 @@ module subroutine regrid_append_file(this,current_time,rc) nsend = nx call MPI_gatherv ( p_dst_2d, nsend, MPI_REAL, & p_dst_2d_full, this%recvcounts, this%displs, MPI_REAL,& - iroot, mpic, ierr ) + iroot, mpic, status ) + _VERIFY(status) call MAPL_TimerOn(this%GENSTATE,"put2D") if (mapl_am_i_root()) then call this%formatter%put_var(item%xname,p_dst_2d_full,& @@ -679,7 +761,8 @@ module subroutine regrid_append_file(this,current_time,rc) nsend = nx * nz call MPI_gatherv ( p_dst_3d, nsend, MPI_REAL, & p_dst_3d_full, recvcounts_3d, displs_3d, MPI_REAL,& - iroot, mpic, ierr ) + iroot, mpic, status ) + _VERIFY(status) call MAPL_TimerOn(this%GENSTATE,"put3D") if (mapl_am_i_root()) then allocate(arr(nz, this%npt_mask_tot), _STAT) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 8a94d5ef5665..ab394566122c 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -1,4 +1,5 @@ #include "MAPL_Generic.h" +#include "MAPL_ErrLog.h" module StationSamplerMod use ESMF use MAPL_ErrorHandlingMod @@ -287,10 +288,12 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, GENSTATE, rc call MPI_Scatterv( sampler%lons, sendcount, & displs, MPI_REAL8, lons_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) call MPI_Scatterv( sampler%lats, sendcount, & displs, MPI_REAL8, lats_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) ! -- root sampler%LSF = LocStreamFactory(sampler%lons, sampler%lats, _RC) @@ -618,6 +621,7 @@ subroutine append_file(this,current_time,rc) call MPI_gatherv ( p_chunk_2d, nsend, MPI_REAL, & p_rt_2d, recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(ierr) call MAPL_TimerOn(this%GENSTATE,"put2D") if (mapl_am_i_root()) then @@ -640,11 +644,11 @@ subroutine append_file(this,current_time,rc) call MAPL_TimerOff(this%GENSTATE,"3d_regrid") call MPI_Barrier(mpic,ierr) - _VERIFY (ierr) + _VERIFY(ierr) call MAPL_TimerOn(this%GENSTATE,"FieldRedist") call ESMF_FieldRedist (new_dst_field, field_chunk_3d, this%RH, _RC) call MPI_Barrier(mpic,ierr) - _VERIFY (ierr) + _VERIFY(ierr) call MAPL_TimerOff(this%GENSTATE,"FieldRedist") @@ -656,7 +660,7 @@ subroutine append_file(this,current_time,rc) call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & p_rt_3d_aux(1,k), recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) - _VERIFY (ierr) + _VERIFY(ierr) end do deallocate(p_dst_t) p_rt_3d = reshape(p_rt_3d_aux, shape(p_rt_3d), order=[2,1]) @@ -664,6 +668,7 @@ subroutine append_file(this,current_time,rc) call MPI_gatherv ( p_chunk_3d, nsend_v, MPI_REAL, & p_rt_3d, recvcount_v, displs_v, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(ierr) end if call MAPL_TimerOff(this%GENSTATE,"gatherv") diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 1ca959172e5c..dc4e8f258851 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -891,14 +891,17 @@ call MPI_Scatterv( this%lons, sendcount, & displs, MPI_REAL8, lons_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) call MPI_Scatterv( this%lats, sendcount, & displs, MPI_REAL8, lats_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) call MPI_Scatterv( this%times_R8, sendcount, & displs, MPI_REAL8, times_R8_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) ! -- root this%locstream_factory = LocStreamFactory(this%lons,this%lats,_RC) @@ -1072,6 +1075,7 @@ call MPI_gatherv ( p_acc_chunk_2d, nsend, MPI_REAL, & p_acc_rt_2d, recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(ierr) if (mapl_am_i_root()) then ! @@ -1136,12 +1140,14 @@ call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & p_acc_rt_3d(1,k), recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(ierr) end do deallocate (p_dst_t) else call MPI_gatherv ( p_dst, nsend_v, MPI_REAL, & p_dst_rt, recvcount_v, displs_v, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(ierr) p_acc_rt_3d = reshape ( p_dst_rt, shape(p_acc_rt_3d), order=[2,1] ) end if diff --git a/gridcomps/Orbit/CMakeLists.txt b/gridcomps/Orbit/CMakeLists.txt index ed51cb1e23cb..09c8c5080337 100644 --- a/gridcomps/Orbit/CMakeLists.txt +++ b/gridcomps/Orbit/CMakeLists.txt @@ -6,12 +6,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/griddedio/CMakeLists.txt b/griddedio/CMakeLists.txt index db7322918aef..bcf44d0be3f8 100644 --- a/griddedio/CMakeLists.txt +++ b/griddedio/CMakeLists.txt @@ -13,12 +13,8 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.pfio MAPL_cfio_r4 TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran) + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index fe2e6fb45be5..7eb3cf53c7f7 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -26,6 +26,7 @@ module MAPL_GriddedIOMod use, intrinsic :: ISO_C_BINDING use, intrinsic :: iso_fortran_env, only: REAL64 use ieee_arithmetic, only: isnan => ieee_is_nan + use netcdf, only: nf90_inq_libvers implicit none private @@ -51,7 +52,7 @@ module MAPL_GriddedIOMod type(VerticalData) :: vdata type(GriddedIOitemVector) :: items integer :: deflateLevel = 0 - integer :: quantizeAlgorithm = 1 + integer :: quantizeAlgorithm = MAPL_NOQUANTIZE integer :: quantizeLevel = 0 integer, allocatable :: chunking(:) logical :: itemOrderAlphabetical = .true. @@ -60,6 +61,7 @@ module MAPL_GriddedIOMod contains procedure :: CreateFileMetaData procedure :: CreateVariable + procedure :: CreateQuantizationInfo procedure :: modifyTime procedure :: modifyTimeIncrement procedure :: bundlePost @@ -190,7 +192,6 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr call this%timeInfo%add_time_to_metadata(this%metadata,rc=status) _VERIFY(status) - iter = this%items%begin() if (.not.allocated(this%chunking)) then call this%set_default_chunking(rc=status) _VERIFY(status) @@ -198,11 +199,16 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr call this%check_chunking(this%vdata%lm,_RC) end if - order = this%metadata%get_order(rc=status) _VERIFY(status) metadataVarsSize = order%size() + ! If quantize algorithm is set, create a quantization_info variable + if (this%quantizeAlgorithm /= MAPL_NOQUANTIZE) then + call this%CreateQuantizationInfo(_RC) + end if + + iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() if (item%itemType == ItemTypeScalar) then @@ -423,6 +429,31 @@ subroutine CreateVariable(this,itemName,rc) #else call v%add_attribute('regrid_method', regrid_method_int_to_string(this%regrid_method)) #endif + ! The CF Convention will soon support quantization. This requires three new attributes + ! if enabled: + ! 1. quantization --> Will point to a quantization_info container with the quantization algorithm + ! (NOTE: this will need to be programmatic when per-variable quantization is enabled) + ! 2a. quantization_nsb --> Number of significant bits (only for bitround) + ! 2b. quantization_nsd --> Number of significant digits (only for bitgroom and granular_bitround) + ! 3. quantization_maximum_relative_error --> Maximum relative error (defined as 2^(-nsb) for bitround, and UNDEFINED? for bitgroom and granular_bitround) + + ! Bitround + if (this%quantizeAlgorithm == MAPL_QUANTIZE_BITROUND) then + call v%add_attribute('quantization', 'quantization_info') + call v%add_attribute('quantization_nsb', this%quantizeLevel) + call v%add_attribute('quantization_maximum_relative_error', 0.5 * 2.0**(-this%quantizeLevel)) + end if + ! granular_bitround and bitgroom + if (this%quantizeAlgorithm == MAPL_QUANTIZE_BITGROOM .or. this%quantizeAlgorithm == MAPL_QUANTIZE_GRANULAR_BITROUND) then + call v%add_attribute('quantization', 'quantization_info') + call v%add_attribute('quantization_nsd', this%quantizeLevel) + ! Per czender, these have maximum_absolute_error. We use the calculate_mae function below + ! which replicates a table in doi 10.5194/gmd-12-4099-2019 + ! NOTE: This might not be the right formula. As the CF Convention draft is updated, + ! we will update this code. + call v%add_attribute('quantization_maximum_absolute_error', calculate_mae(this%quantizeLevel)) + end if + call factory%append_variable_metadata(v) call this%metadata%add_variable(trim(varName),v,rc=status) _VERIFY(status) @@ -442,6 +473,81 @@ subroutine CreateVariable(this,itemName,rc) end subroutine CreateVariable + function calculate_mae(nsd) result(mae) + + ! This function is based on Table 3 of doi 10.5194/gmd-12-4099-2019 + ! The algorithm is weird, but it does duplicate the table + + integer, intent(in) :: nsd + real(kind=REAL32) :: mae + real(kind=REAL32) :: mae_base + integer :: correction + + mae_base = 4.0 * (1.0/16.0)**floor(real(nsd)/2.0) * (1.0/8.0)**ceiling(real(nsd)/2.0) + + correction = 1 + if ( (nsd > 2 .and. mod(nsd, 2) == 0) .or. nsd == 7 ) then + correction = 2 + end if + + mae = mae_base * correction + end function calculate_mae + + subroutine CreateQuantizationInfo(this,rc) + class (MAPL_GriddedIO), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + + class (AbstractGridFactory), pointer :: factory + character(len=:), allocatable :: varName, netcdf_version + type(Variable) :: v + + factory => get_factory(this%output_grid,_RC) + + v = Variable(type=PFIO_CHAR) + + ! In the future when we can do per variable quantization, we will need + ! to do things like quantization_info1, quantization_info2, etc. + ! For now, we will just use quantization_info as it is per collection + varName = "quantization_info" + + ! We need to convert the quantization algorithm to a string + select case (this%quantizeAlgorithm) + case (MAPL_QUANTIZE_BITGROOM) + call v%add_attribute('algorithm', 'bitgroom') + case (MAPL_QUANTIZE_BITROUND) + call v%add_attribute('algorithm', 'bitround') + case (MAPL_QUANTIZE_GRANULAR_BITROUND) + call v%add_attribute('algorithm', 'granular_bitround') + case default + _FAIL('Unknown quantization algorithm') + end select + + ! Next add the implementation details + ! 3. implementation: This property contains free-form text + ! that concisely conveys the algorithm provenance, including the + ! name of the library or client that performed the quantization, + ! the software version, and the name of the author(s) if deemed + ! relevant. + ! + ! In the current case, all algorithms are from libnetcdf + ! we make a string using nf90_inq_libvers() + + netcdf_version = 'libnetcdf ' // nf90_inq_libvers() + call v%add_attribute('implementation', netcdf_version) + + ! NOTE: In the future if we add the MAPL bit-shaving + ! to use the quantization parts of the code, it will + ! need a different implementation string + + call factory%append_variable_metadata(v) + call this%metadata%add_variable(trim(varName),v,_RC) + + _RETURN(_SUCCESS) + + end subroutine CreateQuantizationInfo + subroutine modifyTime(this, oClients, rc) class(MAPL_GriddedIO), intent(inout) :: this type (ClientManager), optional, intent(inout) :: oClients diff --git a/pfio/AbstractServer.F90 b/pfio/AbstractServer.F90 index 968c47904a89..41185b46d47b 100644 --- a/pfio/AbstractServer.F90 +++ b/pfio/AbstractServer.F90 @@ -357,7 +357,7 @@ function get_writing_PE(this,id) result (rank) class(AbstractServer),intent(in) :: this integer, intent(in) :: id integer :: rank - integer :: rank_tmp, ierror + integer :: rank_tmp, ierror, rc integer :: node_rank,innode_rank logical :: yes @@ -371,6 +371,7 @@ function get_writing_PE(this,id) result (rank) rank = 0 if (yes) rank_tmp = this%rank call Mpi_Allreduce(rank_tmp,rank,1, MPI_INTEGER, MPI_SUM, this%comm, ierror) + _VERIFY(ierror) end function get_writing_PE diff --git a/pfio/CMakeLists.txt b/pfio/CMakeLists.txt index 15390fb324e5..3c64d0598926 100644 --- a/pfio/CMakeLists.txt +++ b/pfio/CMakeLists.txt @@ -22,7 +22,7 @@ set (srcs FileMetadata.F90 FileMetadataVector.F90 NetCDF4_FileFormatter.F90 - pfio_nf90_supplement.c + pfio_nf90_supplement.c NetCDF_Supplement.F90 pFIO_Utilities.F90 pFIO.F90 @@ -120,11 +120,7 @@ endif () esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler NetCDF::NetCDF_Fortran NetCDF::NetCDF_C TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl-v2 GFTL_SHARED::gftl-shared-v2 PFLOGGER::pflogger PRIVATE MPI::MPI_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries (${this} PUBLIC GFTL::gftl-v2 GFTL_SHARED::gftl-shared-v2 PFLOGGER::pflogger PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) @@ -150,20 +146,14 @@ ecbuild_add_executable ( SOURCES pfio_server_demo.F90 LIBS ${this} MPI::MPI_Fortran) set_target_properties (pfio_server_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(pfio_server_demo.x OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(pfio_server_demo.x OpenMP::OpenMP_Fortran) ecbuild_add_executable ( TARGET pfio_collective_demo.x SOURCES pfio_collective_demo.F90 LIBS ${this} MPI::MPI_Fortran) set_target_properties (pfio_collective_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(pfio_collective_demo.x OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(pfio_collective_demo.x OpenMP::OpenMP_Fortran) ecbuild_add_executable ( TARGET pfio_writer.x diff --git a/pfio/ClientManager.F90 b/pfio/ClientManager.F90 index 337e1de710f4..cbafb8473bd4 100644 --- a/pfio/ClientManager.F90 +++ b/pfio/ClientManager.F90 @@ -109,6 +109,7 @@ function new_ClientManager(client_comm, unusable, n_client, fast_oclient, rc) re c_manager%client_comm = client_comm call MPI_Comm_rank(client_comm, c_manager%rank, rc) + _VERIFY(rc) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end function new_ClientManager diff --git a/pfio/DirectoryService.F90 b/pfio/DirectoryService.F90 index 47a4cde92ad6..fe5d321a3c78 100644 --- a/pfio/DirectoryService.F90 +++ b/pfio/DirectoryService.F90 @@ -114,6 +114,7 @@ function new_DirectoryService(comm, unusable, rc) result(ds) ! Need to be sure that the directories have been initialized before ! proceeding call MPI_Barrier(comm, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end function new_DirectoryService @@ -129,16 +130,19 @@ integer function make_directory_window(comm, addr) result(win) #if !defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) integer(kind=MPI_ADDRESS_KIND) :: baseaddr #endif - integer :: ierror, rank + integer :: ierror, rank, rc, status call MPI_Comm_Rank(comm, rank, ierror) + _VERIFY(ierror) if (rank == 0) then sz = sizeof_directory() #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Alloc_mem(sz, MPI_INFO_NULL, addr, ierror) + _VERIFY(ierror) #else call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, ierror) + _VERIFY(ierror) addr = transfer(baseaddr, addr) #endif call c_f_pointer(addr, dir) @@ -148,6 +152,7 @@ integer function make_directory_window(comm, addr) result(win) endif call MPI_Win_create(dir, sz, 1, MPI_INFO_NULL, comm, win, ierror) + _VERIFY(ierror) end function make_directory_window @@ -205,6 +210,7 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser end do call MPI_Comm_rank(client_comm, rank_in_client, ierror) + _VERIFY(ierror) if (rank_in_client == 0) then @@ -232,6 +238,7 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser dir_entry%port_name = port_name call MPI_Comm_rank(this%comm, dir_entry%partner_root_rank, ierror) ! global comm + _VERIFY(ierror) dir%entries(n) = dir_entry @@ -245,12 +252,14 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser else call MPI_Recv(server_root_rank, 1, MPI_INTEGER, MPI_ANY_SOURCE, DISCOVERY_TAG, this%comm, status, ierror) end if + _VERIFY(ierror) end if ! complete handshake if (rank_in_client == 0) then call MPI_Comm_size(client_comm, client_npes, ierror) + _VERIFY(ierror) allocate(client_ranks(client_npes)) allocate(server_ranks(client_npes)) else @@ -259,22 +268,29 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser end if call MPI_Gather(this%rank, 1, MPI_INTEGER, client_ranks, 1, MPI_INTEGER, 0, client_comm, ierror) + _VERIFY(ierror) if (rank_in_client == 0) then call MPI_Send(client_npes, 1, MPI_INTEGER, server_root_rank, NPES_TAG, this%comm, ierror) + _VERIFY(ierror) call MPI_Send(client_ranks, client_npes, MPI_INTEGER, server_root_rank, RANKS_TAG, this%comm, ierror) + _VERIFY(ierror) call MPI_Recv(server_ranks, client_npes, MPI_INTEGER, server_root_rank, 0, this%comm, status, ierror) + _VERIFY(ierror) call MPI_Recv(server_npes, 1, MPI_INTEGER, server_root_rank, 0, this%comm, status, ierror) + _VERIFY(ierror) if (present(server_size)) server_size = server_npes end if call MPI_Scatter(server_ranks, 1, MPI_INTEGER, & & server_rank, 1, MPI_INTEGER, & & 0, client_comm, ierror) + _VERIFY(ierror) if (present(server_size)) call MPI_Bcast(server_size, 1, MPI_INTEGER, 0, client_comm,ierror) ! Construct the connection call MPI_Recv(tmp_rank, 1, MPI_INTEGER, server_rank, CONNECT_TAG, this%comm, status, ierror) + _VERIFY(ierror) _ASSERT(tmp_rank == server_rank, "shake the wrong hand") allocate(sckt, source=MpiSocket(this%comm, server_rank, this%parser)) @@ -321,6 +337,7 @@ subroutine connect_to_client(this, port_name, server, rc) endif call MPI_Comm_rank(server_comm, rank_in_server, ierror) + _VERIFY(ierror) if (rank_in_server == 0) then @@ -355,11 +372,14 @@ subroutine connect_to_client(this, port_name, server, rc) else call MPI_Recv(client_root_rank, 1, MPI_INTEGER, MPI_ANY_SOURCE, DISCOVERY_TAG, this%comm, status, ierror) end if + _VERIFY(ierror) if (client_root_rank /= TERMINATE) then ! not a termination signal call MPI_Recv(client_npes, 1, MPI_INTEGER, client_root_rank, NPES_TAG, this%comm, status, ierror) + _VERIFY(ierror) allocate(client_ranks(client_npes)) call MPI_Recv(client_ranks, client_npes, MPI_INTEGER, client_root_rank, RANKS_TAG, this%comm, status, ierror) + _VERIFY(ierror) else client_npes = TERMINATE end if @@ -368,7 +388,9 @@ subroutine connect_to_client(this, port_name, server, rc) call MPI_Comm_size(server_comm, server_npes, ierror) + _VERIFY(ierror) call MPI_Bcast(client_npes, 1, MPI_INTEGER, 0, server_comm, ierror) + _VERIFY(ierror) if (client_npes == TERMINATE) then server%terminate = .true. @@ -394,10 +416,13 @@ subroutine connect_to_client(this, port_name, server, rc) call MPI_GatherV(my_server_ranks, cnts, MPI_INTEGER, & & server_ranks, counts, displs, MPI_INTEGER, & & 0, server_comm, ierror) + _VERIFY(ierror) if (rank_in_server == 0) then call MPI_Send(server_ranks, client_npes, MPI_INTEGER, client_root_rank, 0, this%comm, ierror) + _VERIFY(ierror) call MPI_Send(server_npes, 1, MPI_INTEGER, client_root_rank, 0, this%comm, ierror) + _VERIFY(ierror) endif if (rank_in_server /= 0) then @@ -406,10 +431,12 @@ subroutine connect_to_client(this, port_name, server, rc) call MPI_ScatterV(client_ranks, counts, displs, MPI_INTEGER, & & my_client_ranks, cnts, MPI_INTEGER, & & 0, server_comm, ierror) + _VERIFY(ierror) do p = 1, cnts client_rank = my_client_ranks(p) call MPI_Send(this%rank, 1, MPI_INTEGER, client_rank, CONNECT_TAG, this%comm, ierror) + _VERIFY(ierror) allocate(sckt, source=MpiSocket(this%comm, client_rank, this%parser)) call server%add_connection(sckt) nullify(sckt) @@ -448,6 +475,7 @@ subroutine publish(this, port, server, rc) endif call MPI_Comm_rank(server_comm, rank_in_server, ierror) + _VERIFY(ierror) port_name = port%port_name if (rank_in_server == 0) then @@ -520,15 +548,18 @@ function get_directory(this, win) result(dir) integer :: sz integer(kind=MPI_ADDRESS_KIND) :: disp - integer :: ierror + integer :: ierror, rc call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, win, ierror) + _VERIFY(ierror) sz = sizeof_directory() disp = 0 call MPI_Get(dir, sz, MPI_BYTE, 0, disp, sz, MPI_BYTE, win, ierror) + _VERIFY(ierror) call MPI_Win_unlock(0, win, ierror) + _VERIFY(ierror) return _UNUSED_DUMMY(this) end function get_directory @@ -541,16 +572,19 @@ subroutine put_directory(this, dir, win) integer :: sz integer(kind=MPI_ADDRESS_KIND) :: disp - integer :: ierror + integer :: ierror, rc call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, win, ierror) + _VERIFY(ierror) sz = sizeof_directory() disp = 0 call MPI_put(dir, sz, MPI_BYTE, 0, disp, sz, MPI_BYTE, win, ierror) + _VERIFY(ierror) call MPI_Win_unlock(0, win, ierror) + _VERIFY(ierror) return _UNUSED_DUMMY(this) end subroutine put_directory @@ -564,8 +598,10 @@ subroutine terminate_servers(this, client_comm, rc) integer :: ierror, rank_in_client,i call MPI_Comm_rank(client_comm, rank_in_client, ierror) + _VERIFY(ierror) call MPI_BARRIER(client_comm,ierror) + _VERIFY(ierror) if (rank_in_client ==0) then @@ -577,6 +613,7 @@ subroutine terminate_servers(this, client_comm, rc) call MPI_Send(TERMINATE, 1, MPI_INTEGER, dir%entries(i)%partner_root_rank, DISCOVERY_TAG, & & this%comm, ierror) + _VERIFY(ierror) enddo @@ -594,20 +631,26 @@ subroutine free_directory_resources(this, rc) ! Release resources call MPI_Barrier(this%comm, ierror) + _VERIFY(ierror) call this%mutex%free_mpi_resources() call MPI_Win_free(this%win_server_directory, ierror) + _VERIFY(ierror) call MPI_Win_free(this%win_client_directory, ierror) + _VERIFY(ierror) if (this%rank == 0) then call c_f_pointer(this%server_dir, dir) call MPI_Free_mem(dir, ierror) + _VERIFY(ierror) call c_f_pointer(this%client_dir, dir) call MPI_Free_mem(dir, ierror) + _VERIFY(ierror) end if call Mpi_Comm_free(this%comm, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end subroutine free_directory_resources diff --git a/pfio/MpiMutex.F90 b/pfio/MpiMutex.F90 index 956638ef2102..bfb902aee629 100644 --- a/pfio/MpiMutex.F90 +++ b/pfio/MpiMutex.F90 @@ -1,8 +1,10 @@ ! Lifted from logger project and renamed from MpiLock. Tests were not ! brought over, but was tested using MockMpi prototype. +#include "MAPL_ErrLog.h" module pFIO_MpiMutexMod use mpi + use MAPL_ErrorHandlingMod use iso_c_binding, only: c_ptr, c_f_pointer implicit none private @@ -37,15 +39,18 @@ function new_MpiMutex(comm) result(lock) type (MpiMutex) :: lock integer, intent(in) :: comm - integer :: ierror + integer :: ierror,rc,status integer(kind=MPI_ADDRESS_KIND) :: sz #if !defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) integer(kind=MPI_ADDRESS_KIND) :: baseaddr #endif call MPI_Comm_dup(comm, lock%comm, ierror) + _VERIFY(ierror) call MPI_Comm_rank(lock%comm, lock%rank, ierror) + _VERIFY(ierror) call MPI_Comm_size(lock%comm, lock%npes, ierror) + _VERIFY(ierror) ! This type is used to copy the status of locks on other PE's ! into a table that can be examined on the local process. @@ -55,7 +60,9 @@ function new_MpiMutex(comm) result(lock) blklens = [lock%rank, lock%npes - lock%rank - 1] displs = [0, lock%rank + 1] call MPI_Type_indexed(2, blklens, displs, MPI_LOGICAL, lock%pe_locks_type, ierror); + _VERIFY(ierror) call MPI_Type_commit(lock%pe_locks_type, ierror) + _VERIFY(ierror) end block ! Create windows @@ -66,11 +73,14 @@ function new_MpiMutex(comm) result(lock) integer :: sizeof_logical call MPI_Type_extent(MPI_LOGICAL, sizeof_logical, ierror) + _VERIFY(ierror) sz = lock%npes * sizeof_logical #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Alloc_mem(sz, MPI_INFO_NULL, lock%locks_ptr, ierror) + _VERIFY(ierror) #else call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, ierror) + _VERIFY(ierror) lock%locks_ptr = transfer(baseaddr, lock%locks_ptr) #endif @@ -79,6 +89,7 @@ function new_MpiMutex(comm) result(lock) call MPI_Win_create(scratchpad, sz, sizeof_logical, & & MPI_INFO_NULL, lock%comm, lock%window, ierror) + _VERIFY(ierror) end block else ! local window memory is size 0, but have to pass something @@ -86,6 +97,7 @@ function new_MpiMutex(comm) result(lock) logical :: buffer(1) sz = 0 call MPI_Win_create(buffer, sz, 1, MPI_INFO_NULL, lock%comm, lock%window, ierror) + _VERIFY(ierror) end block end if @@ -98,15 +110,19 @@ end function new_MpiMutex subroutine acquire(this) class (MpiMutex), intent(inout) :: this - integer :: ierror + integer :: ierror,rc,status call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, ierror) + _VERIFY(ierror) call MPI_Get(this%local_data, this%npes-1, MPI_LOGICAL, 0, & & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, ierror) + _VERIFY(ierror) call MPI_Put(.true., 1, MPI_LOGICAL, 0, int(this%rank,kind=MPI_ADDRESS_KIND), & & 1, MPI_LOGICAL, this%window, ierror) + _VERIFY(ierror) call MPI_Win_unlock(0, this%window, ierror) + _VERIFY(ierror) ! Check other processes for holding the lock if (any(this%local_data)) then ! wait for signal from process with the lock @@ -114,6 +130,7 @@ subroutine acquire(this) integer :: buffer ! unused call MPI_Recv(buffer, 0, MPI_LOGICAL, MPI_ANY_SOURCE, & & LOCK_TAG, this%comm, MPI_STATUS_IGNORE, ierror) + _VERIFY(ierror) end block end if @@ -124,14 +141,18 @@ end subroutine acquire subroutine release(this) class (MpiMutex), intent(inout) :: this - integer :: ierror + integer :: ierror,rc,status call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, ierror) + _VERIFY(ierror) call MPI_Get(this%local_data, this%npes-1, MPI_LOGICAL, 0, & & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, ierror) + _VERIFY(ierror) call MPI_Put(.false., 1, MPI_LOGICAL, 0, int(this%rank,kind=MPI_ADDRESS_KIND), & & 1, MPI_LOGICAL, this%window, ierror) + _VERIFY(ierror) call MPI_Win_unlock(0, this%window, ierror) + _VERIFY(ierror) ! who needs the lock next (if anyone)? block @@ -156,6 +177,7 @@ subroutine release(this) if (next_rank /= -1) then call MPI_Send(buffer, 0, MPI_LOGICAL, next_rank, & & LOCK_TAG, this%comm, ierror) + _VERIFY(ierror) end if end block @@ -165,17 +187,21 @@ subroutine free_mpi_resources(this) class (MpiMutex), intent(inout) :: this logical, pointer :: scratchpad(:) - integer :: ierror + integer :: ierror,rc,status ! Release resources call MPI_Type_free(this%pe_locks_type, ierror) + _VERIFY(ierror) call MPI_Win_free(this%window, ierror) + _VERIFY(ierror) if (this%rank == 0) then call c_f_pointer(this%locks_ptr, scratchpad, [this%npes]) call MPI_Free_mem(scratchpad, ierror) + _VERIFY(ierror) end if call Mpi_comm_free(this%comm, ierror) + _VERIFY(ierror) end subroutine free_mpi_resources diff --git a/pfio/MpiSocket.F90 b/pfio/MpiSocket.F90 index b7b6d7a60c49..a0e5098d2772 100644 --- a/pfio/MpiSocket.F90 +++ b/pfio/MpiSocket.F90 @@ -78,9 +78,11 @@ function new_MpiSocket(comm, remote_rank, parser, rc) result(s) s%world_remote_rank = remote_rank call MPI_Comm_rank(comm, local_rank, ierror) + _VERIFY(ierror) s%world_local_rank = local_rank call MPI_Comm_group(comm, world_group, ierror) + _VERIFY(ierror) ! Enforce consistent ordering in new communicator/group if (local_rank < remote_rank) then @@ -93,7 +95,9 @@ function new_MpiSocket(comm, remote_rank, parser, rc) result(s) s%pair_remote_rank = 0 end if call MPI_Group_incl(world_group, 2, ranks, pair_group, ierror) + _VERIFY(ierror) call MPI_Comm_create_group(comm, pair_group, PAIR_TAG, s%pair_comm, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end function new_MpiSocket @@ -108,11 +112,14 @@ function receive(this, rc) result(message) integer :: count call MPI_Probe(this%pair_remote_rank, MESSAGE_TAG, this%pair_comm, status, ierror) + _VERIFY(ierror) call MPI_Get_count(status, MPI_INTEGER, count, ierror) + _VERIFY(ierror) allocate(buffer(count)) call MPI_Recv(buffer, count, MPI_INTEGER, this%pair_remote_rank, MESSAGE_TAG, this%pair_comm, & & status, ierror) + _VERIFY(ierror) allocate(message, source=this%parser%decode(buffer)) _RETURN(_SUCCESS) @@ -129,6 +136,7 @@ subroutine send(this, message, rc) buffer = this%parser%encode(message) call MPI_Send(buffer, size(buffer), MPI_INTEGER, this%pair_remote_rank, MESSAGE_TAG, this%pair_comm, & & ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end subroutine send @@ -165,6 +173,7 @@ function put(this, request_id, local_reference, rc) result(handle) call c_f_pointer(local_reference%base_address, data, shape=[n_words]) if (n_words ==0) allocate(data(1)) call MPI_Isend(data, n_words, MPI_INTEGER, this%pair_remote_rank, tag, this%pair_comm, request, ierror) + _VERIFY(ierror) allocate(handle, source=MpiRequestHandle(local_reference, request)) if (n_words ==0) deallocate(data) _RETURN(_SUCCESS) @@ -190,6 +199,7 @@ function get(this, request_id, local_reference, rc) result(handle) call c_f_pointer(local_reference%base_address, data, shape=[n_words]) if (n_words ==0) allocate(data(1)) call MPI_Irecv(data, n_words, MPI_INTEGER, this%pair_remote_rank, tag, this%pair_comm, request, ierror) + _VERIFY(ierror) allocate(handle, source=MpiRequestHandle(local_reference, request)) if (n_words ==0) deallocate(data) _RETURN(_SUCCESS) diff --git a/pfio/MultiCommServer.F90 b/pfio/MultiCommServer.F90 index 3b0afb0f13e2..c4a56b80d2f1 100644 --- a/pfio/MultiCommServer.F90 +++ b/pfio/MultiCommServer.F90 @@ -90,6 +90,7 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul s%server_comm = server_comm call MPI_Comm_size(s%server_comm, s_size , ierror) + _VERIFY(ierror) s%splitter = SimpleCommsplitter(s%server_comm) node_sizes = s%splitter%get_node_sizes() @@ -108,6 +109,7 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul allocate(s%back_ranks(nwriter)) allocate(s%front_ranks(s%nfront)) call MPI_Comm_rank(s%server_comm, s_rank, ierror) + _VERIFY(ierror) s_name = s_comm%get_name() s%I_am_front_root = .false. s%I_am_back_root = .false. @@ -116,16 +118,21 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul call s%init(s%front_comm, s_name) s%port_name = trim(port_name) call MPI_Comm_rank(s%front_comm, local_rank, ierror) + _VERIFY(ierror) if (s_rank == 0) then _ASSERT( local_rank == 0, "re-arrange the rank of the server_comm") s%I_am_front_root = .true. call MPI_recv(s%back_ranks, nwriter, MPI_INTEGER, MPI_ANY_SOURCE, 666, s%server_comm, MPI_STAT,ierror) + _VERIFY(ierror) endif call MPI_Bcast(s%back_ranks, nwriter, MPI_INTEGER, 0, s%front_comm, ierror) + _VERIFY(ierror) call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%front_ranks, 1, MPI_INTEGER, s%front_comm, ierror) + _VERIFY(ierror) if (local_rank ==0 ) then call MPI_Send(s%front_ranks, s_size-nwriter, MPI_INTEGER, s%back_ranks(1), 777, s%server_comm, ierror) + _VERIFY(ierror) endif endif @@ -133,18 +140,23 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul if (index(s_name, 'o_server_back') /=0) then s%back_comm = s_comm%get_subcommunicator() call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%back_ranks, 1, MPI_INTEGER, s%back_comm, ierror) + _VERIFY(ierror) call MPI_Comm_rank(s%back_comm, local_rank, ierror) + _VERIFY(ierror) if (local_rank ==0 ) then s%I_am_back_root = .true. call MPI_Send(s%back_ranks, nwriter, MPI_INTEGER, 0, 666, s%server_comm, ierror) + _VERIFY(ierror) endif if (s_rank == s%back_ranks(1)) then _ASSERT( local_rank == 0, "re-arrange the rank of the server_comm") call MPI_recv(s%front_ranks, s%nfront, MPI_INTEGER, MPI_ANY_SOURCE, 777, s%server_comm, MPI_STAT,ierror) + _VERIFY(ierror) endif call MPI_Bcast(s%front_ranks, s%nfront, MPI_INTEGER, 0, s%back_comm, ierror) + _VERIFY(ierror) call s%set_status(1) call s%add_connection(dummy_socket) endif @@ -174,12 +186,14 @@ subroutine start_back(rc) integer :: my_rank, cmd, status call MPI_Comm_rank(this%server_comm, my_rank, ierr) + _VERIFY(ierr) allocate(this%serverthread_done_msgs(1)) this%serverthread_done_msgs(:) = .false. do while (.true.) call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, ierr) + _VERIFY(ierr) if (cmd == -1) exit call this%create_remote_win(_RC) call this%receive_output_data(_RC) @@ -228,6 +242,7 @@ subroutine start_front(rc) call this%threads%clear() call MPI_Bcast(terminate, 1, MPI_INTEGER, 0, this%server_comm, ierr) + _VERIFY(ierr) deallocate(mask) _RETURN(_SUCCESS) end subroutine start_front @@ -258,12 +273,13 @@ subroutine create_remote_win(this, rc) integer :: MPI_STAT(MPI_STATUS_SIZE) character(len=*),parameter :: Iam = 'create_remote_win' class (ServerThread),pointer :: thread_ptr - integer :: bsize, ierr + integer :: bsize, ierr, status integer :: cmd = 1 integer, allocatable :: buffer(:) if (this%front_comm /= MPI_COMM_NULL) then call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, ierr) + _VERIFY(ierr) endif this%stage_offset = StringInteger64map() @@ -274,12 +290,15 @@ subroutine create_remote_win(this, rc) call serialize_message_vector(thread_ptr%request_backlog,buffer) bsize = size(buffer) call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) + _VERIFY(ierr) call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) call HistoryCollectionVector_serialize(thread_ptr%hist_collections, buffer) bsize = size(buffer) call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) + _VERIFY(ierr) call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) + _VERIFY(ierr) endif @@ -288,14 +307,18 @@ subroutine create_remote_win(this, rc) call MPI_recv( bsize, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) allocate(buffer(bsize)) call MPI_recv( buffer,bsize, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) endif call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, ierr) + _VERIFY(ierr) if (.not. allocated(buffer)) allocate(buffer(bsize)) call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, ierr) + _VERIFY(ierr) call deserialize_message_vector(buffer, thread_ptr%request_backlog) deallocate (buffer) @@ -303,14 +326,18 @@ subroutine create_remote_win(this, rc) call MPI_recv( bsize, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) allocate(buffer(bsize)) call MPI_recv( buffer,bsize, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) endif call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, ierr) + _VERIFY(ierr) if (.not. allocated(buffer)) allocate(buffer(bsize)) call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, ierr) + _VERIFY(ierr) call HistoryCollectionVector_deserialize(buffer, thread_ptr%hist_collections) deallocate (buffer) endif @@ -380,7 +407,7 @@ subroutine put_DataToFile(this, rc) class (AbstractDataReference), pointer :: dataRefPtr type (LocalMemReference), pointer :: memdataPtr=>null() integer(kind=MPI_ADDRESS_KIND) :: msize - integer :: num_clients, l_rank, w_rank, ierr, empty(0) + integer :: num_clients, l_rank, w_rank, ierr, empty(0), status !real(KIND=REAL64) :: t0, t1 !t0 = 0.0d0 @@ -394,6 +421,7 @@ subroutine put_DataToFile(this, rc) if (this%back_comm /= MPI_COMM_NULL) then call MPI_comm_rank(this%back_comm, l_rank, ierr) + _VERIFY(ierr) ! copy and save the data do collection_counter = 1, this%dataRefPtrs%size() dataRefPtr => this%get_dataReference(collection_counter) @@ -464,6 +492,7 @@ subroutine clean_up(this, rc) if (this%back_Comm /= MPI_COMM_NULL) then ! time to write file call MPI_comm_rank(this%back_comm, l_rank, ierr) + _VERIFY(ierr) threadPtr=>this%threads%at(1) msg_iter = threadPtr%request_backlog%begin() diff --git a/pfio/MultiGroupServer.F90 b/pfio/MultiGroupServer.F90 index 77da6fb43348..0268f5c00ca9 100644 --- a/pfio/MultiGroupServer.F90 +++ b/pfio/MultiGroupServer.F90 @@ -387,11 +387,13 @@ subroutine receive_output_data(this, rc) if (this%I_am_front_root) then collection_id = collection_ids%at(collection_counter) call Mpi_Send(collection_id, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_comm, ierror) + _VERIFY(ierror) msg =>f_d_ms(collection_counter)%msg_vec%at(1) ! just pick first one. All messages should have the same filename select type (q=>msg) class is (AbstractCollectiveDataMessage) Filename = q%file_name call Mpi_Send(FileName, FNAME_LEN, MPI_CHARACTER, this%back_ranks(1), this%back_ranks(1), this%server_comm, ierror) + _VERIFY(ierror) class default _FAIL( "yet to implemented") end select @@ -402,27 +404,36 @@ subroutine receive_output_data(this, rc) endif call Mpi_Bcast( collection_id, 1, MPI_INTEGER, 0, this%front_comm, ierror) + _VERIFY(ierror) if (associated(ioserver_profiler)) call ioserver_profiler%start("collection_"//i_to_string(collection_id)) if (this%I_am_front_root) then call Mpi_Recv(back_local_rank, 1, MPI_INTEGER, this%back_ranks(1), & this%front_ranks(1), this%server_comm, MPI_STAT, ierror) + _VERIFY(ierror) msg_size= size(buffer) call Mpi_send(msg_size,1, MPI_INTEGER, this%back_ranks(back_local_rank+1), & this%back_ranks(back_local_rank+1), this%server_comm, ierror) + _VERIFY(ierror) call Mpi_send(buffer,msg_size, MPI_INTEGER, this%back_ranks(back_local_rank+1), & this%back_ranks(back_local_rank+1), this%server_comm, ierror) + _VERIFY(ierror) endif call Mpi_Bcast( back_local_rank, 1, MPI_INTEGER, 0, this%front_comm, ierror) - if (allocated(this%buffers(back_local_rank+1)%buffer)) call MPI_Wait(this%buffers(back_local_rank+1)%request, MPI_STAT, ierror) + _VERIFY(ierror) + if (allocated(this%buffers(back_local_rank+1)%buffer)) then + call MPI_Wait(this%buffers(back_local_rank+1)%request, MPI_STAT, ierror) + _VERIFY(ierror) + endif call f_d_ms(collection_counter)%serialize(this%buffers(back_local_rank+1)%buffer) call f_d_ms(collection_counter)%destroy(_RC) msg_size= size(this%buffers(back_local_rank+1)%buffer) call Mpi_send(msg_size,1, MPI_INTEGER, this%back_ranks(back_local_rank+1), & this%back_ranks(back_local_rank+1), this%server_comm, ierror) + _VERIFY(ierror) call Mpi_Isend(this%buffers(back_local_rank+1)%buffer, msg_size, MPI_INTEGER, this%back_ranks(back_local_rank+1), & this%back_ranks(back_local_rank+1), this%server_comm, this%buffers(back_local_rank+1)%request,ierror) if (associated(ioserver_profiler)) call ioserver_profiler%stop("collection_"//i_to_string(collection_id)) @@ -483,11 +494,13 @@ subroutine start_back_captain(rc) call MPI_recv( collection_id, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) if (collection_id == -1) exit call MPI_recv( FileName, FNAME_LEN , MPI_CHARACTER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) ! 2) get an idle processor and notify front root call dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc=status) _VERIFY(status) @@ -500,6 +513,7 @@ subroutine start_back_captain(rc) ! this serves the syncronization with oserver terminate = -1 call MPI_send(terminate, 1, MPI_INTEGER, 0, 0, this%server_comm, ierr) + _VERIFY(ierr) deallocate(num_idlePEs, idleRank) _RETURN(_SUCCESS) end subroutine start_back_captain @@ -528,10 +542,12 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) do local_rank = 1, this%nwriter-1 flag = .false. call MPI_Iprobe( local_rank, stag, this%back_comm, flag, MPI_STAT, ierr) + _VERIFY(ierr) if (flag) then call MPI_recv(idle_writer, 1, MPI_INTEGER, & local_rank, stag, this%back_comm, & MPI_STAT, ierr) + _VERIFY(ierr) _ASSERT(local_rank == idle_writer, "local_rank and idle_writer should match") node_rank = this%node_ranks(local_rank) num_idlePEs(node_rank) = num_idlePEs(node_rank) + 1 @@ -541,6 +557,7 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) call MPI_recv(FileDone, FNAME_LEN, MPI_CHARACTER, & local_rank, stag+1, this%back_comm, & MPI_STAT, ierr) + _VERIFY(ierr) iter = FilesBeingWritten%find(FileDone) _ASSERT( iter /= FilesBeingWritten%end(), "FileDone should be in the set") @@ -571,9 +588,11 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) ! 2.2) tell front comm which idel_worker is ready call MPI_send(idle_writer, 1, MPI_INTEGER, this%front_ranks(1), & this%front_ranks(1), this%server_comm, ierr) + _VERIFY(ierr) ! 2.3) forward the collection_id to the idle_writer call MPI_send(collection_id, 1, MPI_INTEGER, idle_writer, idle_writer,this%back_comm, ierr) + _VERIFY(ierr) _RETURN(_SUCCESS) end subroutine dispatch_work @@ -594,16 +613,20 @@ subroutine terminate_back_writers(idleRank, rc) if (idleRank(node_rank, nth_writer) >=1) then ! send no_job directly to terminate call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, ierr) + _VERIFY(ierr) else ! For busy worker, wait to receive idle_writer and the send no_job call MPI_recv( idle_writer, 1, MPI_INTEGER, & local_rank, stag, this%back_comm, & MPI_STAT, ierr) + _VERIFY(ierr) call MPI_recv( FileDone, FNAME_LEN, MPI_CHARACTER, & local_rank, stag+1, this%back_comm, & MPI_STAT, ierr) + _VERIFY(ierr) _ASSERT(local_rank == idle_writer, "local_rank and idle_writer should match") call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, ierr) + _VERIFY(ierr) endif enddo _RETURN(_SUCCESS) @@ -652,6 +675,7 @@ subroutine start_back_writers(rc) call MPI_recv( collection_id, 1, MPI_INTEGER, & 0, back_local_rank, this%back_comm, & MPI_STAT, ierr) + _VERIFY(ierr) if (collection_id == -1 ) exit ! exit when get terminate signal !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! sync with create_remote_win from front_com @@ -663,20 +687,24 @@ subroutine start_back_writers(rc) call MPI_recv( msg_size, 1, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) allocate(buffer_fmd(msg_size)) call MPI_recv( buffer_fmd(1), msg_size, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) endif call MPI_recv( msg_size, 1, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & MPI_STAT, ierr) + _VERIFY(ierr) if (allocated(this%buffers(i)%buffer)) deallocate (this%buffers(i)%buffer) allocate(this%buffers(i)%buffer(msg_size)) call MPI_Irecv( this%buffers(i)%buffer(1), msg_size, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, this%buffers(i)%request, & ierr) + _VERIFY(ierr) enddo ! nfront ! re-org data @@ -688,6 +716,7 @@ subroutine start_back_writers(rc) s0 = 1 f_d_m = ForwardDataAndMessage() call MPI_Wait(this%buffers(i)%request, MPI_STAT, ierr) + _VERIFY(ierr) call f_d_m%deserialize(this%buffers(i)%buffer) deallocate(this%buffers(i)%buffer) if (size(f_d_m%idata) ==0) cycle @@ -856,8 +885,10 @@ subroutine start_back_writers(rc) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! call MPI_send(back_local_rank, 1, MPI_INTEGER, 0, stag, this%back_comm , ierr) + _VERIFY(ierr) FileDone = Filename call MPI_send(FileDone, FNAME_LEN, MPI_CHARACTER, 0, stag+1, this%back_comm , ierr) + _VERIFY(ierr) enddo _RETURN(_SUCCESS) end subroutine start_back_writers @@ -868,7 +899,7 @@ subroutine terminate_backend_server(this, rc) class (MultiGroupServer), intent(inout) :: this integer, optional, intent(out) :: rc integer :: terminate - integer :: ierr, i + integer :: ierr, i, status integer :: MPI_STAT(MPI_STATUS_SIZE) terminate = -1 diff --git a/pfio/MultiLayerServer.F90 b/pfio/MultiLayerServer.F90 index 4e8e45c8da72..9cd9da3763c0 100644 --- a/pfio/MultiLayerServer.F90 +++ b/pfio/MultiLayerServer.F90 @@ -119,14 +119,16 @@ end subroutine start subroutine terminate_writers(this) class (MultiLayerServer), intent(inout) :: this integer :: terminate = -1 - integer :: ierr + integer :: ierr, status, rc integer :: MPI_STAT(MPI_STATUS_SIZE) ! The root rank sends termination signal to the root of the spawned children which would ! send terminate back for synchronization ! if no syncrohization, the writer may be still writing while the main testing node is comparing if( this%rank == 0 .and. this%nwriters > 1 ) then call MPI_send(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) call MPI_recv(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, MPI_STAT, ierr) + _VERIFY(ierr) endif end subroutine terminate_writers @@ -218,6 +220,7 @@ subroutine put_DataToFile(this, rc) call forData%clear() endif call MPI_Barrier(this%comm, status) + _VERIFY(status) endif ! first thread n==1 call threadPtr%clear_backlog() call threadPtr%clear_hist_collections() @@ -244,17 +247,23 @@ subroutine forward_DataToWriter(forwardVec, forwardData, rc) bsize = size(buffer) call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) call MPI_recv(writer_rank, 1, MPI_INTEGER, & 0, pFIO_s_tag, this%Inter_Comm , & MPI_STAT, ierr) + _VERIFY(ierr) !forward Message call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) !send number of collections call StringAttributeMap_serialize(forwardData,buffer) bsize = size(buffer) call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) !2) send the data _RETURN(_SUCCESS) diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index 26b894e39b44..7ffc315bbbba 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -600,7 +600,6 @@ subroutine put_var_attributes(this, var, varid, unusable, rc) iter = attributes%begin() do while (iter /= attributes%end()) attr_name => iter%key() - p_attribute => iter%value() shp = p_attribute%get_shape() if (size(shp) == 0) then ! scalar @@ -1079,9 +1078,12 @@ subroutine inq_var_attributes(this, var, varid, unusable, rc) call var%add_attribute(trim(attr_name), str) deallocate(str) case (NF90_STRING) - !W.Y. Note: pfio does not support variable's string attribute - ! It only supports global 1-d string attribute - cycle + !$omp critical + status = pfio_get_att_string(this%ncid, varid, trim(attr_name), str) + !$omp end critical + _VERIFY(status) + call var%add_attribute(trim(attr_name), str) + deallocate(str) case default _RETURN(_FAILURE) end select diff --git a/pfio/RDMAReference.F90 b/pfio/RDMAReference.F90 index 5b556391188a..ce3c07b59541 100644 --- a/pfio/RDMAReference.F90 +++ b/pfio/RDMAReference.F90 @@ -48,6 +48,7 @@ function new_RDMAReference(type_kind,msize_word,comm, rank, rc) result(reference reference%msize_word = msize_word reference%type_kind = type_kind call Mpi_comm_dup(Comm,reference%comm,status) + _VERIFY(status) reference%mem_rank = rank call reference%allocate(rc=status) _VERIFY(status) @@ -123,6 +124,7 @@ subroutine allocate(this, rc) n_bytes = this%msize_word * int_size call MPI_Comm_rank(this%comm,Rank,status) + _VERIFY(status) windowsize = 0_MPI_ADDRESS_KIND if (Rank == this%mem_rank) windowsize = n_bytes diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index d7c9b31299b2..02cd5f5da63b 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -389,6 +389,7 @@ function read_and_gather(this, rc) result(dataRefPtr) call MPI_AllGATHERV(locals, local_size, MPI_INTEGER, & i_ptr, int(offsets), int(g_offsets), MPI_INTEGER, & this%containing_server%NodeRoot_Comm,status) + _VERIFY(status) deallocate(locals) endif diff --git a/pfio/ShmemReference.F90 b/pfio/ShmemReference.F90 index b71ced10ea91..3c2683bf4b96 100644 --- a/pfio/ShmemReference.F90 +++ b/pfio/ShmemReference.F90 @@ -45,6 +45,7 @@ function new_ShmemReference(type_kind,msize_word,InNode_Comm, rc) result(referen reference%msize_word = msize_word reference%type_kind = type_kind call Mpi_comm_dup(InNode_Comm,reference%InNode_Comm,status) + _VERIFY(status) call reference%allocate(rc=status) _VERIFY(status) @@ -117,6 +118,7 @@ subroutine allocate(this, rc) n_bytes = this%msize_word * 4_MPI_ADDRESS_KIND call MPI_Comm_rank(this%InNode_Comm,InNode_Rank,ierr) + _VERIFY(ierr) disp_unit = 1 windowsize = 0_MPI_ADDRESS_KIND @@ -125,18 +127,22 @@ subroutine allocate(this, rc) #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Win_allocate_shared(windowsize, disp_unit, MPI_INFO_NULL, this%InNode_Comm, & this%base_address, this%win, ierr) + _VERIFY(ierr) #else call MPI_Win_allocate_shared(windowsize, disp_unit, MPI_INFO_NULL, this%InNode_Comm, & baseaddr, this%win, ierr) + _VERIFY(ierr) this%base_address = transfer(baseaddr, this%base_address) #endif if (InNode_Rank /= 0) then #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Win_shared_query(this%win, 0, windowsize, disp_unit, this%base_address,ierr) + _VERIFY(ierr) #else call MPI_Win_shared_query(this%win, 0, windowsize, disp_unit, baseaddr,ierr) this%base_address = transfer(baseaddr, this%base_address) + _VERIFY(ierr) #endif endif @@ -154,8 +160,11 @@ subroutine deallocate(this, rc) endif call MPI_Win_fence(0, this%win, ierr) + _VERIFY(ierr) call MPI_Win_free(this%win,ierr) + _VERIFY(ierr) call MPI_Comm_free(this%InNode_Comm, ierr) + _VERIFY(ierr) this%shmem_allocated = .false. _RETURN(_SUCCESS) end subroutine deallocate @@ -169,6 +178,7 @@ subroutine fence(this, rc) _RETURN(_SUCCESS) endif call Mpi_Win_fence(0, this%win, ierr) + _VERIFY(ierr) _RETURN(_SUCCESS) end subroutine fence diff --git a/pfio/Variable.F90 b/pfio/Variable.F90 index 9d42cf97f7f2..624954bfd162 100644 --- a/pfio/Variable.F90 +++ b/pfio/Variable.F90 @@ -28,7 +28,7 @@ module pFIO_VariableMod type (StringAttributeMap) :: attributes type (UnlimitedEntity) :: const_value integer :: deflation = 0 ! default no compression - integer :: quantize_algorithm = 1 ! default bitgroom + integer :: quantize_algorithm = 0 ! default no quantization integer :: quantize_level = 0 ! default no quantize_level integer, allocatable :: chunksizes(:) contains @@ -85,7 +85,7 @@ function new_Variable(unusable, type, dimensions, chunksizes,const_value, deflat var%type = -1 var%deflation = 0 - var%quantize_algorithm = 1 + var%quantize_algorithm = 0 var%quantize_level = 0 var%chunksizes = empty var%dimensions = StringVector() diff --git a/pfio/pfio_base.F90 b/pfio/pfio_base.F90 index b35b4516f8f6..1abe7b53acf9 100644 --- a/pfio/pfio_base.F90 +++ b/pfio/pfio_base.F90 @@ -1,14 +1,18 @@ +#undef I_AM_MAIN +#include "MAPL_ErrLog.h" module pfio_base + use MAPL_ErrorHandlingMod integer, save :: debug_unit = 0 contains subroutine pfio_init() use MPI character(len=5) :: buf - integer :: rank, ierror + integer :: rank, ierror, rc, status if (debug_unit == 0) then call MPI_Comm_rank(MPI_Comm_world, rank, ierror) + _VERIFY(ierror) write(buf,'(i5.5)') rank open(newunit=debug_unit,file='pfio_debug.'//buf,status='unknown', form='formatted') end if diff --git a/pfio/pfio_collective_demo.F90 b/pfio/pfio_collective_demo.F90 index 82c8a34955bb..efa79e9fd70d 100644 --- a/pfio/pfio_collective_demo.F90 +++ b/pfio/pfio_collective_demo.F90 @@ -114,6 +114,8 @@ end subroutine process_command_line end module collective_demo_CLI +!#undef I_AM_MAIN +#include "MAPL_ErrLog.h" module FakeExtDataMod_collective use, intrinsic :: iso_fortran_env, only: INT64 use MAPL_ExceptionHandling @@ -165,7 +167,7 @@ subroutine init(this, options, comm, d_s, port_name) class (AbstractDirectoryService), target,intent(inout) :: d_s character(*), intent(in) :: port_name - integer :: ierror + integer :: ierror, status, rc type (FileMetadata) :: file_metadata type (NetCDF4_FileFormatter) :: formatter type (StringIntegerMap) :: dims @@ -182,8 +184,10 @@ subroutine init(this, options, comm, d_s, port_name) this%comm = comm - call MPI_Comm_rank(comm,this%rank,ierror) - call MPI_Comm_size(comm,this%npes,ierror) + call MPI_Comm_rank(comm,this%rank, ierror) + _VERIFY(ierror) + call MPI_Comm_size(comm,this%npes, ierror) + _VERIFY(ierror) allocate(this%bundle(this%vars%size())) @@ -293,6 +297,8 @@ end subroutine finalize end module FakeExtDataMod_collective +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program main use mpi use pFIO @@ -302,7 +308,7 @@ program main implicit none integer :: rank, npes, ierror, provided,required - integer :: status, color, key + integer :: status, color, key, rc class(AbstractServer),pointer :: server class(AbstractDirectoryService), pointer :: d_s => null() @@ -317,9 +323,12 @@ program main type (FakeExtData), target :: extData required = MPI_THREAD_MULTIPLE - call MPI_init_thread(required, provided, ierror) - call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) - call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + call MPI_init_thread(required, provided, ierror) + _VERIFY(ierror) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) + call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + _VERIFY(ierror) call process_command_line(options, rc=status) @@ -336,7 +345,8 @@ program main color = split_color(options%server_type,options%npes_server) key = 0 - call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror) + call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror) + _VERIFY(ierror) if (color == SERVER_COLOR .or. color == BOTH_COLOR) then ! server diff --git a/pfio/pfio_parallel_netcdf_reproducer.F90 b/pfio/pfio_parallel_netcdf_reproducer.F90 index a7a812b2a27b..9e74b00228ae 100644 --- a/pfio/pfio_parallel_netcdf_reproducer.F90 +++ b/pfio/pfio_parallel_netcdf_reproducer.F90 @@ -1,10 +1,13 @@ +#undef I_AM_MAIN +#include "MAPL_ErrLog.h" program main use MPI use FLAP use pFIO + use MAPL_ErrorHandlingMod implicit none - integer :: ierror + integer :: ierror, rc type (command_line_interface) :: cli integer :: im integer :: lm @@ -12,6 +15,7 @@ program main character(:), allocatable :: output_filename call MPI_Init(ierror) + _VERIFY(ierror) call cli%init(description='potential reproducer of parallel netcdf problem on SCU12') call add_cli_options(cli) @@ -85,7 +89,9 @@ subroutine run(im, lm, n_fields, output_filename) character(3) :: field_idx_str call mpi_comm_size(MPI_COMM_WORLD, npes, ierror) + _VERIFY(ierror) call mpi_comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) jm = im*6 ! pseudo cubed sphere call metadata%add_dimension('IM_WORLD', im) diff --git a/pfio/pfio_server_demo.F90 b/pfio/pfio_server_demo.F90 index a03a54c234f9..cdebf0d71bac 100644 --- a/pfio/pfio_server_demo.F90 +++ b/pfio/pfio_server_demo.F90 @@ -117,7 +117,10 @@ end subroutine process_command_line end module server_demo_CLI +!#undef I_AM_MAIN +#include "MAPL_ErrLog.h" module FakeExtDataMod_server + use MAPL_ExceptionHandling use server_demo_CLI use pFIO use gFTL_StringVector @@ -165,7 +168,7 @@ subroutine init(this, options, comm, d_s) integer, intent(in) :: comm class (AbstractDirectoryService), target,intent(inout) :: d_s - integer :: ierror + integer :: ierror, rc, status type (FileMetadata) :: file_metadata type (NetCDF4_FileFormatter) :: formatter type (StringIntegerMap) :: dims @@ -178,8 +181,10 @@ subroutine init(this, options, comm, d_s) this%vars = options%requested_variables this%comm = comm - call MPI_Comm_rank(comm,this%rank,ierror) - call MPI_Comm_size(comm,this%npes,ierror) + call MPI_Comm_rank(comm,this%rank, ierror) + _VERIFY(ierror) + call MPI_Comm_size(comm,this%npes, ierror) + _VERIFY(ierror) allocate(this%bundle(this%vars%size())) @@ -262,6 +267,8 @@ end subroutine finalize end module FakeExtDataMod_server +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program main use mpi use pFIO @@ -271,7 +278,7 @@ program main implicit none integer :: rank, npes, ierror, provided - integer :: status, color, key + integer :: status, color, key, rc class(BaseServer),allocatable :: s @@ -285,8 +292,11 @@ program main class(AbstractDirectoryService), pointer :: d_s=>null() call MPI_init_thread(MPI_THREAD_MULTIPLE, provided, ierror) + _VERIFY(ierror) call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + _VERIFY(ierror) call process_command_line(options, rc=status) @@ -299,6 +309,7 @@ program main key = 0 call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror) + _VERIFY(ierror) !C$ num_threads = 20 allocate(d_s, source = DirectoryService(MPI_COMM_WORLD)) diff --git a/pfio/pfio_writer.F90 b/pfio/pfio_writer.F90 index 7feb925a69c1..3836605869db 100644 --- a/pfio/pfio_writer.F90 +++ b/pfio/pfio_writer.F90 @@ -1,3 +1,4 @@ +#define I_AM_MAIN #include "MAPL_ErrLog.h" #include "unused_dummy.H" @@ -22,7 +23,7 @@ program main implicit none integer :: Inter_Comm - integer :: ierr + integer :: ierr, rc integer :: rank integer :: server_rank @@ -42,9 +43,13 @@ program main class (AbstractMessage), pointer :: msg call MPI_Init(ierr) + _VERIFY(ierr) call MPI_Comm_get_parent(Inter_Comm, ierr); + _VERIFY(ierr) call MPI_Comm_rank(MPI_COMM_WORLD,rank, ierr) + _VERIFY(ierr) call MPI_Comm_size(MPI_COMM_WORLD,n_workers, ierr) + _VERIFY(ierr) allocate(busy(n_workers-1), source =0) @@ -55,6 +60,7 @@ program main call MPI_recv( command, 1, MPI_INTEGER, & MPI_ANY_SOURCE, pFIO_s_tag, Inter_Comm, & MPI_STAT, ierr) + _VERIFY(ierr) server_rank = MPI_STAT(MPI_SOURCE) if (command == 1) then ! server is asking for a writing node @@ -74,26 +80,32 @@ program main call MPI_recv( idle, 1, MPI_INTEGER, & MPI_ANY_SOURCE, pFIO_w_m_tag , MPI_COMM_WORLD, & MPI_STAT, ierr) + _VERIFY(ierr) idle_worker = idle endif ! tell server the idel_worker call MPI_send(idle_worker, 1, MPI_INTEGER, server_rank, pFIO_s_tag, Inter_Comm, ierr) + _VERIFY(ierr) busy(idle_worker) = 1 ! tell the idle_worker which server has work call MPI_send(server_rank, 1, MPI_INTEGER, idle_worker, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + _VERIFY(ierr) else ! command /=1, notify the worker to quit and finalize no_job = -1 do i = 1, n_workers -1 if ( busy(i) == 0) then call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + _VERIFY(ierr) else call MPI_recv( idle, 1, MPI_INTEGER, & i, pFIO_w_m_tag, MPI_COMM_WORLD, & MPI_STAT, ierr) + _VERIFY(ierr) if (idle /= i ) stop ("idle should be i") call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + _VERIFY(ierr) endif enddo exit @@ -108,6 +120,7 @@ program main call MPI_recv( server_rank, 1, MPI_INTEGER, & 0, pFIO_m_w_tag, MPI_COMM_WORLD, & MPI_STAT, ierr) + _VERIFY(ierr) if (server_rank == -1 ) exit !--------------------------------------------------- @@ -116,19 +129,23 @@ program main call MPI_recv( msg_size, 1, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & MPI_STAT, ierr) + _VERIFY(ierr) allocate(bufferm(msg_size)) call MPI_recv( bufferm, msg_size, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & MPI_STAT, ierr) + _VERIFY(ierr) call MPI_recv( data_size, 1, MPI_INTEGER,& server_rank, pFIO_s_tag, Inter_comm, & MPI_STAT, ierr) + _VERIFY(ierr) allocate(bufferd(data_size)) call MPI_recv( bufferd, data_size, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & MPI_STAT, ierr) + _VERIFY(ierr) ! deserilize message and data call deserialize_message_vector(bufferm, forwardVec) @@ -168,17 +185,20 @@ program main ! telling captain, I am the soldier that is ready to have more work call MPI_send(rank, 1, MPI_INTEGER, 0, pFIO_w_m_tag, MPI_COMM_WORLD , ierr) + _VERIFY(ierr) enddo endif call MPI_Barrier(MPI_COMM_WORLD, ierr) + _VERIFY(ierr) if ( rank == 0) then ! send done message to server ! this serves the syncronization with oserver command = -1 call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, Inter_Comm, ierr) + _VERIFY(ierr) endif call MPI_Finalize(ierr) diff --git a/pfio/tests/CMakeLists.txt b/pfio/tests/CMakeLists.txt index 29fe0153030e..8d7b9b077d4b 100644 --- a/pfio/tests/CMakeLists.txt +++ b/pfio/tests/CMakeLists.txt @@ -64,10 +64,7 @@ ecbuild_add_executable ( SOURCES pfio_ctest_io.F90 LIBS MAPL.shared MAPL.pfio NetCDF::NetCDF_Fortran MPI::MPI_Fortran DEFINITIONS USE_MPI) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${TESTO} OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(${TESTO} OpenMP::OpenMP_Fortran) set_target_properties(${TESTO} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) # Detect if we are using Open MPI and add oversubscribe @@ -126,11 +123,7 @@ ecbuild_add_executable ( SOURCES pfio_performance.F90 DEFINITIONS USE_MPI LIBS MAPL.pfio NetCDF::NetCDF_Fortran MPI::MPI_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${TESTPERF} OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${TESTPERF} MAPL.pfio NetCDF::NetCDF_Fortran) +target_link_libraries(${TESTPERF} MAPL.pfio NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran) set_target_properties(${TESTPERF} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) add_test(NAME pFIO_performance diff --git a/profiler/AbstractMeter.F90 b/profiler/AbstractMeter.F90 index 7c91982c1b62..f88030251b60 100644 --- a/profiler/AbstractMeter.F90 +++ b/profiler/AbstractMeter.F90 @@ -1,5 +1,7 @@ #include "unused_dummy.H" +#include "MAPL_ErrLog.h" module MAPL_AbstractMeter + use MAPL_ErrorHandlingMod use, intrinsic :: iso_fortran_env, only: REAL64 implicit none private @@ -60,14 +62,18 @@ end subroutine i_accumulate subroutine finalize(this, rc) class(AbstractMeter), intent(in) :: this integer, optional, intent(out) :: rc - integer :: ierror + integer :: ierror, status ierror = 0 if (dist_initialized) then call MPI_type_free(type_dist_struct, ierror) + _VERIFY(ierror) call MPI_type_free(type_dist_real64, ierror) + _VERIFY(ierror) call MPI_type_free(type_dist_integer, ierror) + _VERIFY(ierror) call MPI_Op_free(dist_reduce_op,ierror) + _VERIFY(ierror) dist_initialized = .false. endif if (present(rc)) rc = ierror diff --git a/profiler/CMakeLists.txt b/profiler/CMakeLists.txt index b3d17fce4219..259b45748d43 100644 --- a/profiler/CMakeLists.txt +++ b/profiler/CMakeLists.txt @@ -51,11 +51,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES GFTL_SHARED::gftl-shared GFTL::gftl-v1 GFTL::gftl-v2 MAPL.shared MPI::MPI_Fortran TYPE ${MAPL_LIBRARY_TYPE}) target_include_directories (${this} PRIVATE ${MAPL_SOURCE_DIR}/include) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) add_subdirectory (demo EXCLUDE_FROM_ALL) if (PFUNIT_FOUND) diff --git a/profiler/DistributedMeter.F90 b/profiler/DistributedMeter.F90 index dcac1341552e..770c42235eb7 100644 --- a/profiler/DistributedMeter.F90 +++ b/profiler/DistributedMeter.F90 @@ -1,7 +1,9 @@ #include "unused_dummy.H" +#include "MAPL_ErrLog.h" module MAPL_DistributedMeter use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_ErrorHandlingMod use MAPL_AbstractMeter use MAPL_AdvancedMeter use MAPL_AbstractGauge @@ -140,12 +142,15 @@ subroutine initialize(ierror) type (DistributedMeter) :: dummy logical :: commute + integer :: rc, status call dummy%make_mpi_type(dummy%statistics, type_dist_struct, ierror) call MPI_Type_commit(type_dist_struct, ierror) + _VERIFY(ierror) commute = .true. call MPI_Op_create(true_reduce, commute, dist_reduce_op, ierror) + _VERIFY(ierror) end subroutine initialize @@ -276,8 +281,10 @@ subroutine reduce_mpi(this, comm, exclusive) integer :: rank type(DistributedStatistics) :: tmp + integer :: rc, status call MPI_Comm_rank(comm, rank, ierror) + _VERIFY(ierror) this%statistics%total = DistributedReal64(this%get_total(), rank) this%statistics%exclusive = DistributedReal64(exclusive, rank) @@ -288,6 +295,7 @@ subroutine reduce_mpi(this, comm, exclusive) tmp = this%statistics call MPI_Reduce(tmp, this%statistics, 1, type_dist_struct, dist_reduce_op, 0, comm, ierror) + _VERIFY(ierror) end subroutine reduce_mpi @@ -300,13 +308,16 @@ subroutine make_mpi_type_distributed_real64(this, r64, new_type, ierror) integer(kind=MPI_ADDRESS_KIND) :: displacements(2) integer(kind=MPI_ADDRESS_KIND) :: lb, sz + integer :: rc, status _UNUSED_DUMMY(this) _UNUSED_DUMMY(r64) call MPI_Type_get_extent_x(MPI_REAL8, lb, sz, ierror) + _VERIFY(ierror) displacements = [0_MPI_ADDRESS_KIND, 3*sz] call MPI_Type_create_struct(2, [3,4], displacements, [MPI_REAL8, MPI_INTEGER], new_type, ierror) + _VERIFY(ierror) end subroutine make_mpi_type_distributed_real64 @@ -318,11 +329,13 @@ subroutine make_mpi_type_distributed_integer(this, int, new_type, ierror) integer, intent(out) :: ierror integer(kind=MPI_ADDRESS_KIND) :: displacements(1) + integer :: rc, status _UNUSED_DUMMY(this) _UNUSED_DUMMY(int) displacements = [0_MPI_ADDRESS_KIND] call MPI_Type_create_struct(1, [6], displacements, [MPI_INTEGER], new_type, ierror) + _VERIFY(ierror) end subroutine make_mpi_type_distributed_integer @@ -335,15 +348,19 @@ subroutine make_mpi_type_distributed_data(this, d, new_type, ierror) integer(kind=MPI_ADDRESS_KIND) :: displacements(2) integer(kind=MPI_ADDRESS_KIND) :: lb, sz, sz2 + integer :: rc, status _UNUSED_DUMMY(d) call this%make_mpi_type(this%statistics%total, type_dist_real64, ierror) call this%make_mpi_type(this%statistics%num_cycles, type_dist_integer, ierror) call MPI_Type_get_extent_x(type_dist_real64, lb, sz, ierror) + _VERIFY(ierror) displacements = [0_MPI_ADDRESS_KIND, 6*sz] call MPI_Type_create_struct(2, [6,1], displacements, [type_dist_real64, type_dist_integer], new_type, ierror) + _VERIFY(ierror) call MPI_Type_get_extent_x(new_type, lb, sz2, ierror) + _VERIFY(ierror) end subroutine make_mpi_type_distributed_data diff --git a/profiler/VmstatMemoryGauge.F90 b/profiler/VmstatMemoryGauge.F90 index 30b203d03fd9..5fc0451de51d 100644 --- a/profiler/VmstatMemoryGauge.F90 +++ b/profiler/VmstatMemoryGauge.F90 @@ -1,5 +1,7 @@ #include "unused_dummy.H" +#include "MAPL_ErrLog.h" module MAPL_VmstatMemoryGauge + use MAPL_ErrorHandlingMod use, intrinsic :: iso_fortran_env, only: REAL64, INT64 use MAPL_AbstractGauge implicit none @@ -40,8 +42,9 @@ function get_measurement(this) result(mem_use) _UNUSED_DUMMY(this) block use MPI - integer :: rank, ierror + integer :: rank, ierror, status, rc call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) allocate(character(4) :: tmp_file) write(tmp_file,'(i4.4)')rank tmp_file = 'tmp_' // tmp_file // '.dat' diff --git a/profiler/demo/demo.F90 b/profiler/demo/demo.F90 index 3ea422c138c4..91f7828f4f9f 100644 --- a/profiler/demo/demo.F90 +++ b/profiler/demo/demo.F90 @@ -1,6 +1,9 @@ +#define I_AM_MAIN +638 #include "MAPL_ErrLog.h" program main use MPI use MAPL_Profiler + use MAPL_ErrorHandlingMod implicit none @@ -12,9 +15,10 @@ program main character(:), allocatable :: report_lines(:) integer :: i - integer :: ierror + integer :: ierror, rc, status call MPI_Init(ierror) + _VERIFY(ierror) main_prof = TimeProfiler('TOTAL') ! timer 1 call main_prof%start() lap_prof = TimeProfiler('Lap') diff --git a/profiler/demo/mpi_demo.F90 b/profiler/demo/mpi_demo.F90 index 3fcad3a91caa..970cf75845d8 100644 --- a/profiler/demo/mpi_demo.F90 +++ b/profiler/demo/mpi_demo.F90 @@ -1,5 +1,8 @@ +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program main use mapl_Profiler + use MAPL_ErrorHandlingMod use MPI implicit none @@ -12,13 +15,15 @@ program main character(:), allocatable :: report_lines(:) integer :: i - integer :: rank, ierror + integer :: rank, ierror, rc, status character(1) :: empty(0) !$ mem_prof = MemoryProfiler('TOTAL') call MPI_Init(ierror) + _VERIFY(ierror) call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) main_prof = DistributedProfiler('TOTAL', MpiTimerGauge(), MPI_COMM_WORLD) ! timer 1 call main_prof%start() @@ -109,6 +114,7 @@ program main write(*,'(a)') '' end if call MPI_Barrier(MPI_COMM_WORLD, ierror) + _VERIFY(ierror) if (rank == 1) then write(*,'(a)')'Final profile (1)' write(*,'(a)')'================' @@ -118,6 +124,7 @@ program main write(*,'(a)') '' end if call MPI_Barrier(MPI_COMM_WORLD, ierror) + _VERIFY(ierror) report_lines = main_reporter%generate_report(main_prof) if (rank == 0) then diff --git a/profiler/tests/test_PercentageColumn.pf b/profiler/tests/test_PercentageColumn.pf index 2d3047938346..39d7368e86ee 100644 --- a/profiler/tests/test_PercentageColumn.pf +++ b/profiler/tests/test_PercentageColumn.pf @@ -13,10 +13,10 @@ contains type (MeterNode), target :: node class (AbstractMeterNode), pointer :: child class (AbstractMeter), pointer :: t - type(UnlimitedVector) :: v + type(UnlimitedVector), target :: v integer :: i integer :: expected(2) - class(*), allocatable :: q + class(*), pointer :: q node = MeterNode('foo', AdvancedMeter(MpiTimerGauge())) t => node%get_meter() @@ -26,19 +26,19 @@ contains child => node%get_child('a') t => child%get_meter() call t%add_cycle(5.0_REAL64) - + c = PercentageColumn(InclusiveColumn(),'MAX') v = c%get_rows(node) expected = [100.,50.] do i = 1, 2 - q = v%at(i) + q => v%at(i) select type (q) type is (real(kind=REAL64)) @assertEqual(expected(i), q) end select end do - + end subroutine test_percent_inclusive end module test_PercentageColumn diff --git a/shared/CMakeLists.txt b/shared/CMakeLists.txt index 94f9336e8c79..a1b88404dd40 100644 --- a/shared/CMakeLists.txt +++ b/shared/CMakeLists.txt @@ -35,11 +35,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.constants GFTL_SHARED::gftl-shared MPI::MPI_Fortran PFLOGGER::pflogger TYPE ${MAPL_LIBRARY_TYPE}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) diff --git a/shared/Constants/InternalConstants.F90 b/shared/Constants/InternalConstants.F90 index ac2935ea9911..3cad2914e86f 100644 --- a/shared/Constants/InternalConstants.F90 +++ b/shared/Constants/InternalConstants.F90 @@ -166,13 +166,17 @@ module MAPL_InternalConstantsMod integer, parameter :: MAPL_NBITS_NOT_SET = 1000 integer, parameter :: MAPL_NBITS_UPPER_LIMIT = 24 - ! Constants for netCDF quantize + ! Constants for netCDF quantize (these echo the values in the netcdf-fortran library) enum, bind(c) - enumerator MAPL_Quantize_Disabled - enumerator MAPL_Quantize_BitGroom - enumerator MAPL_Quantize_GranularBR - enumerator MAPL_Quantize_BitRound + enumerator MAPL_NOQUANTIZE + enumerator MAPL_QUANTIZE_BITGROOM + enumerator MAPL_QUANTIZE_GRANULAR_BITROUND + enumerator MAPL_QUANTIZE_BITROUND endenum + ! Maximum number of significant digits for quantization (bitgroom, granular_bitround) + integer, parameter :: MAPL_QUANTIZE_MAX_NSD = 7 + ! Maximum number of significant bits for quantization (bitround) + integer, parameter :: MAPL_QUANTIZE_MAX_NSB = 23 ! Constant masking enum, bind(c) enumerator MAPL_MASK_OUT diff --git a/udunits2f/CMakeLists.txt b/udunits2f/CMakeLists.txt new file mode 100644 index 000000000000..9ddd633fc535 --- /dev/null +++ b/udunits2f/CMakeLists.txt @@ -0,0 +1,28 @@ +esma_set_this (OVERRIDE udunits2f) + +set(srcs + CptrWrapper.F90 + UDSystem.F90 + udunits2f.F90 + encoding.F90 + interfaces.F90 + status_codes.F90 + ut_set_ignore_error_message_handler.c + ) +list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}") + +esma_add_library(${this} + SRCS ${srcs} + TYPE SHARED +) + +find_package(udunits REQUIRED) +find_package(EXPAT REQUIRED) + +target_link_libraries(${this} PUBLIC udunits::udunits) +target_link_libraries(${this} PUBLIC EXPAT::EXPAT) + +if (PFUNIT_FOUND) + # Turning off until test with GNU can be fixed + add_subdirectory(tests EXCLUDE_FROM_ALL) +endif () diff --git a/udunits2f/CptrWrapper.F90 b/udunits2f/CptrWrapper.F90 new file mode 100644 index 000000000000..8b0143c6b70b --- /dev/null +++ b/udunits2f/CptrWrapper.F90 @@ -0,0 +1,64 @@ +module ud2f_CptrWrapper + use, intrinsic :: iso_c_binding, only: c_ptr, C_NULL_PTR, c_associated + implicit none + private + + public :: CptrWrapper + +!================================ CPTRWRAPPER ================================== +! Base class to wrap type(c_ptr) instances used for udunits2 objects that cannot +! interface directly to fortran. Each extended class must provide a subroutine +! to free the memory associated with cptr_ + type, abstract :: CptrWrapper + private + type(c_ptr) :: cptr_ = C_NULL_PTR + contains + procedure :: get_cptr + procedure :: set_cptr + procedure :: is_free + procedure :: free + procedure(I_free_memory), deferred :: free_memory + end type CptrWrapper + + abstract interface + + subroutine I_free_memory(this) + import :: CptrWrapper + class(CptrWrapper), intent(in) :: this + end subroutine I_Free_Memory + + end interface + +contains + + type(c_ptr) function get_cptr(this) + class(CptrWrapper), intent(in) :: this + + get_cptr = this%cptr_ + + end function get_cptr + + subroutine set_cptr(this, cptr) + class(CptrWrapper), intent(inout) :: this + type(c_ptr), intent(in) :: cptr + this%cptr_ = cptr + end subroutine set_cptr + + logical function is_free(this) + class(CptrWrapper), intent(in) :: this + + is_free = .not. c_associated(this%cptr_) + + end function is_free + + ! Free up memory pointed to by cptr_ and set cptr_ to c_null_ptr + subroutine free(this) + class(CptrWrapper), intent(inout) :: this + + if(this%is_free()) return + call this%free_memory() + this%cptr_ = c_null_ptr + + end subroutine free + +end module ud2f_CptrWrapper diff --git a/udunits2f/UDSystem.F90 b/udunits2f/UDSystem.F90 new file mode 100644 index 000000000000..0fe1386978ed --- /dev/null +++ b/udunits2f/UDSystem.F90 @@ -0,0 +1,444 @@ +#include "error_handling.h" + +module ud2f_UDSystem + use ud2f_CptrWrapper + use ud2f_interfaces + use ud2f_encoding + use ud2f_status_codes + use iso_c_binding, only: c_ptr, c_associated, c_null_ptr, c_null_char + use iso_c_binding, only: c_char, c_int, c_float, c_double, c_loc + implicit none + private + + public :: Converter + public :: get_converter + public :: initialize + public :: finalize + + public :: UDUnit + public :: are_convertible + public :: UDSystem + public :: cstring + public :: read_xml + public :: ut_free_system + +!================================= CONVERTER =================================== +! Converter object to hold convert functions for an (order) pair of units + type, extends(CptrWrapper) :: Converter + private + contains + procedure :: free_memory => free_cv_converter + procedure, private :: convert_float_0d + procedure, private :: convert_float_1d + procedure, private :: convert_float_2d + procedure, private :: convert_float_3d + procedure, private :: convert_float_4d + procedure, private :: convert_float_5d + procedure, private :: convert_double_0d + procedure, private :: convert_double_1d + procedure, private :: convert_double_2d + procedure, private :: convert_double_3d + procedure, private :: convert_double_4d + procedure, private :: convert_double_5d + + generic :: convert => convert_float_0d + generic :: convert => convert_float_1d + generic :: convert => convert_float_2d + generic :: convert => convert_float_3d + generic :: convert => convert_float_4d + generic :: convert => convert_float_5d + generic :: convert => convert_double_0d + generic :: convert => convert_double_1d + generic :: convert => convert_double_2d + generic :: convert => convert_double_3d + generic :: convert => convert_double_4d + generic :: convert => convert_double_5d + end type Converter + + interface Converter + module procedure :: construct_converter + end interface Converter + +!=============================== UDSYSTEM ================================= +! udunits2 unit system: encoding is the encoding for unit names and symbols. + type, extends(CptrWrapper) :: UDSystem + private + integer(ut_encoding) :: encoding = UT_ASCII + contains + procedure, public, pass(this) :: free_memory => free_ut_system + end type UDSystem + + interface UDSystem + module procedure :: construct_system + end interface UDSystem + +!=================================== UDUNIT ==================================== +! measurement unit in udunits2 system + type, extends(CptrWrapper) :: UDUnit + contains + procedure, public, pass(this) :: free_memory => free_ut_unit + end type UDUnit + + interface UDUnit + module procedure :: construct_unit + end interface UDUnit + + interface are_convertible + procedure :: are_convertible_udunit + procedure :: are_convertible_str + end interface are_convertible + +!============================= INSTANCE VARIABLES ============================== +! Single instance of units system. There is one system in use, only. + type(UDSystem), private :: SYSTEM_INSTANCE + +contains + + ! Check the status for the last udunits2 call + logical function success(utstatus) + integer(ut_status) :: utstatus + + success = (utstatus == UT_SUCCESS) + + end function success + + function construct_system(path, encoding) result(instance) + type(UDsystem) :: instance + character(len=*), optional, intent(in) :: path + integer(ut_encoding), optional, intent(in) :: encoding + type(c_ptr) :: utsystem + integer(ut_status) :: status + + ! Read in unit system from path + call read_xml(path, utsystem, status) + + if(success(status)) then + call instance%set_cptr(utsystem) + if(present(encoding)) instance%encoding = encoding + return + end if + + ! Free memory in the case of failure + if(c_associated(utsystem)) call ut_free_system(utsystem) + + end function construct_system + + function construct_unit(identifier) result(instance) + type(UDUnit) :: instance + character(len=*), intent(in) :: identifier + character(kind=c_char, len=:), allocatable :: cchar_identifier + type(c_ptr) :: utunit1 + + ! Unit system must be initialized (instantiated). + if(instance_is_uninitialized()) return + + cchar_identifier = cstring(identifier) + utunit1 = ut_parse(SYSTEM_INSTANCE%get_cptr(), cchar_identifier, SYSTEM_INSTANCE%encoding) + + if(success(ut_get_status())) then + call instance%set_cptr(utunit1) + else + ! Free memory in the case of failure + if(c_associated(utunit1)) call ut_free(utunit1) + end if + + end function construct_unit + + function construct_converter(from_unit, to_unit) result(conv) + type(Converter) :: conv + type(UDUnit), intent(in) :: from_unit + type(UDUnit), intent(in) :: to_unit + type(c_ptr) :: cvconverter1 + logical :: convertible + + ! Must supply units that are initialized and convertible + if(from_unit%is_free() .or. to_unit%is_free()) return + if(.not. are_convertible(from_unit, to_unit)) return + + cvconverter1 = ut_get_converter(from_unit%get_cptr(), to_unit%get_cptr()) + + if(success(ut_get_status())) then + call conv%set_cptr(cvconverter1) + else + ! Free memory in the case of failure + if(c_associated(cvconverter1)) call cv_free(cvconverter1) + end if + + end function construct_converter + + ! Get Converter object based on unit names or symbols + subroutine get_converter(conv, from, to, rc) + type(Converter),intent(inout) :: conv + character(len=*), intent(in) :: from, to + integer(ut_status), optional, intent(out) :: rc + integer(ut_status) :: status + + conv = get_converter_function(from, to) + _ASSERT(.not. conv%is_free(), UTF_CONVERTER_NOT_INITIALIZED) + + _RETURN(UT_SUCCESS) + end subroutine get_converter + + ! Get converter object + function get_converter_function(from, to) result(conv) + type(Converter) :: conv + character(len=*), intent(in) :: from, to + type(UDUnit) :: from_unit + type(UDUnit) :: to_unit + + ! Unit system must be initialized (instantiated). + if(instance_is_uninitialized()) return + + ! Get units based on strings. Free memory on fail. + from_unit = UDUnit(from) + if(from_unit%is_free()) return + to_unit = UDUnit(to) + if(to_unit%is_free()) then + call from_unit%free() + return + end if + + conv = Converter(from_unit, to_unit) + + ! Units are no longer needed + call from_unit%free() + call to_unit%free() + + end function get_converter_function + + function convert_float_0d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from + real(c_float) :: to + to = cv_convert_float(this%get_cptr(), from) + end function convert_float_0d + + function convert_float_1d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:) + real(c_float) :: to(size(from)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_1d + + function convert_float_2d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:,:) + real(c_float) :: to(size(from,1), size(from,2)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_2d + + function convert_float_3d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:,:,:) + real(c_float) :: to(size(from,1), size(from,2), size(from,3)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_3d + + function convert_float_4d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:,:,:,:) + real(c_float) :: to(size(from,1), size(from,2), size(from,3), size(from,4)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_4d + + function convert_float_5d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:,:,:,:,:) + real(c_float) :: to(size(from,1), size(from,2), size(from,3), size(from,4), size(from,5)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_5d + + function convert_double_0d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from + real(c_double) :: to + to = cv_convert_double(this%get_cptr(), from) + end function convert_double_0d + + function convert_double_1d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:) + real(c_double) :: to(size(from)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_1d + + function convert_double_2d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:,:) + real(c_double) :: to(size(from,1), size(from,2)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_2d + + function convert_double_3d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:,:,:) + real(c_double) :: to(size(from,1), size(from,2), size(from,3)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_3d + + function convert_double_4d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:,:,:,:) + real(c_double) :: to(size(from,1), size(from,2), size(from,3), size(from,4)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_4d + + function convert_double_5d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:,:,:,:,:) + real(c_double) :: to(size(from,1), size(from,2), size(from,3), size(from,4), size(from,5)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_5d + + ! Read unit database from XML + subroutine read_xml(path, utsystem, status) + character(len=*), optional, intent(in) :: path + type(c_ptr), intent(out) :: utsystem + integer(ut_status), intent(out) :: status + + character(kind=c_char, len=:), target, allocatable :: cchar_path + + if(present(path)) then + cchar_path = cstring(path) + utsystem = ut_read_xml_cptr(c_loc(cchar_path)) + else + utsystem = ut_read_xml_cptr(c_null_ptr) + end if + status = ut_get_status() + + end subroutine read_xml + + ! Initialize unit system instance + subroutine initialize(path, encoding, rc) + character(len=*), optional, intent(in) :: path + integer(ut_encoding), optional, intent(in) :: encoding + integer, optional, intent(out) :: rc + integer :: status + + _RETURN_UNLESS(instance_is_uninitialized()) + ! System must be once and only once. + _ASSERT(instance_is_uninitialized(), UTF_DUPLICATE_INITIALIZATION) + + ! Disable error messages from udunits2 + call disable_ut_error_message_handler() + + call initialize_system(SYSTEM_INSTANCE, path, encoding, rc=status) + if(status /= UT_SUCCESS) then + ! On failure, free memory + call finalize() + _RETURN(UTF_INITIALIZATION_FAILURE) + end if + _ASSERT(.not. SYSTEM_INSTANCE%is_free(), UTF_NOT_INITIALIZED) + _RETURN(UT_SUCCESS) + + end subroutine initialize + + subroutine initialize_system(system, path, encoding, rc) + type(UDSystem), intent(inout) :: system + character(len=*), optional, intent(in) :: path + integer(ut_encoding), optional, intent(in) :: encoding + integer, optional, intent(out) :: rc + integer :: status + type(c_ptr) :: utsystem + + ! A system can be initialized only once. + _ASSERT(system%is_free(), UTF_DUPLICATE_INITIALIZATION) + + system = UDSystem(path, encoding) + _RETURN(UT_SUCCESS) + end subroutine initialize_system + + ! Is the instance of the unit system initialized? + logical function instance_is_uninitialized() + + instance_is_uninitialized = SYSTEM_INSTANCE%is_free() + + end function instance_is_uninitialized + + ! Free memory for unit system + subroutine free_ut_system(this) + class(UDSystem), intent(in) :: this + + if(this%is_free()) return + call ut_free_system(this%get_cptr()) + + end subroutine free_ut_system + + ! Free memory for unit + subroutine free_ut_unit(this) + class(UDUnit), intent(in) :: this + + if(this%is_free()) return + call ut_free(this%get_cptr()) + + end subroutine free_ut_unit + + ! Free memory for converter + subroutine free_cv_converter(this) + class(Converter), intent(in) :: this + type(c_ptr) :: cvconverter1 + + if(this%is_free()) return + call cv_free(this%get_cptr()) + + end subroutine free_cv_converter + + ! Free memory for unit system instance + subroutine finalize() + + if(SYSTEM_INSTANCE%is_free()) return + call SYSTEM_INSTANCE%free() + + end subroutine finalize + + ! Check if units are convertible + function are_convertible_udunit(unit1, unit2, rc) result(convertible) + logical :: convertible + type(UDUnit), intent(in) :: unit1, unit2 + integer, optional, intent(out) :: rc + integer :: status + integer(c_int), parameter :: ZERO = 0_c_int + + convertible = (ut_are_convertible(unit1%get_cptr(), unit2%get_cptr()) /= ZERO) + status = ut_get_status() + _ASSERT(success(status), status) + + _RETURN(UT_SUCCESS) + end function are_convertible_udunit + + ! Check if units are convertible + function are_convertible_str(from, to, rc) result(convertible) + logical :: convertible + character(*), intent(in) :: from, to + integer, optional, intent(out) :: rc + + integer :: status + type(UDUnit) :: unit1, unit2 + + unit1 = UDUnit(from) + unit2 = UDUnit(to) + convertible = are_convertible_udunit(unit1, unit2, _RC) + + _RETURN(UT_SUCCESS) + end function are_convertible_str + + ! Create C string from Fortran string + function cstring(s) result(cs) + character(len=*), intent(in) :: s + character(kind=c_char, len=:), allocatable :: cs + + cs = adjustl(trim(s)) // c_null_char + + end function cstring + + ! Set udunits2 error handler to ut_ignore which does nothing + subroutine disable_ut_error_message_handler(is_set) + logical, optional, intent(out) :: is_set + logical, save :: handler_set = .FALSE. + + if(.not. handler_set) call ut_set_ignore_error_message_handler() + handler_set = .TRUE. + if(present(is_set)) is_set = handler_set + end subroutine disable_ut_error_message_handler + +end module ud2f_UDSystem diff --git a/udunits2f/encoding.F90 b/udunits2f/encoding.F90 new file mode 100644 index 000000000000..0daa08205deb --- /dev/null +++ b/udunits2f/encoding.F90 @@ -0,0 +1,17 @@ +! Flags for encodings for unit names and symbols +! The values are the same as the udunits2 utEncoding C enum +module ud2f_encoding + implicit none + public + + enum, bind(c) + enumerator :: UT_ASCII = 0 + enumerator :: UT_ISO_8859_1 = 1 + enumerator :: UT_LATIN1 = UT_ISO_8859_1 + enumerator :: UT_UTF8 = 2 + enumerator :: UT_ENCODING_DEFAULT = UT_ASCII + end enum + integer, parameter :: ut_encoding = kind(UT_ENCODING_DEFAULT) + +end module ud2f_encoding + diff --git a/udunits2f/error_handling.h b/udunits2f/error_handling.h new file mode 100644 index 000000000000..78892070d455 --- /dev/null +++ b/udunits2f/error_handling.h @@ -0,0 +1,6 @@ +#define _RETURN(status) if(present(rc)) then; rc=status; return; endif +#define _RETURN_UNLESS(cond) if (.not. cond) then; _RETURN(UT_SUCCESS); endif +#define _ASSERT(cond, msg) if (.not. (cond)) then; _RETURN(msg); endif +#define _RC rc=status); _ASSERT(rc==UT_SUCCESS, status + +!rc=status); if (.not. (rc==UT_SUCCESS)) then; if(present(rc)) then; rc=status; return; endif; endif diff --git a/udunits2f/interfaces.F90 b/udunits2f/interfaces.F90 new file mode 100644 index 000000000000..34d47e205f50 --- /dev/null +++ b/udunits2f/interfaces.F90 @@ -0,0 +1,138 @@ +module ud2f_interfaces + use ud2f_encoding, only: ut_encoding + use ud2f_status_codes, only: ut_status + use, intrinsic :: iso_c_binding, only: c_ptr, c_char, c_int, c_float, c_double + implicit none + private + + public :: ut_get_status, ut_parse + public :: ut_read_xml_cptr + public :: ut_get_converter, ut_are_convertible + public :: cv_convert_double, cv_convert_float + public :: cv_convert_doubles, cv_convert_floats + public :: ut_free, ut_free_system, cv_free + public :: ut_set_ignore_error_message_handler + interface + + ! Procedures that return type(c_ptr) return a C null pointer on failure. + ! However, checking for the C null pointer IS NOT a good check for status. + ! ut_get_status is a better check, where UT_SUCCESS indicates success. + + ! Return type(c_ptr) to ut_system units database specified by path + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + type(c_ptr) function ut_read_xml_cptr(path) bind(c, name='ut_read_xml') + import :: c_ptr + type(c_ptr), value :: path + end function ut_read_xml_cptr + + ! Get status code + integer(ut_status) function ut_get_status() bind(c, name='ut_get_status') + import :: ut_status + end function ut_get_status + + ! Return non-zero value if unit1 can be converted to unit2, otherwise 0 + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + integer(c_int) function ut_are_convertible(unit1, unit2) & + bind(c, name='ut_are_convertible') + import :: c_int, c_ptr + type(c_ptr), value, intent(in) :: unit1, unit2 + end function ut_are_convertible + + ! Return type(c_ptr) to cv_converter + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + type(c_ptr) function ut_get_converter(from, to) & + bind(c, name='ut_get_converter') + import :: c_ptr + type(c_ptr), value, intent(in) :: from, to + end function ut_get_converter + + ! Use converter to convert value_ + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + real(c_float) function cv_convert_float(converter, value_) bind(c) + import :: c_ptr, c_float + type(c_ptr), value, intent(in) :: converter + real(c_float), value, intent(in) :: value_ + end function cv_convert_float + + ! Use converter to convert value_ + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + real(c_double) function cv_convert_double(converter, value_) bind(c) + import :: c_ptr, c_double + type(c_ptr), value, intent(in) :: converter + real(c_double), value, intent(in) :: value_ + end function cv_convert_double + + ! Use converter to convert in_ and put it in out_. + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + subroutine cv_convert_doubles(converter, in_, count_, out_) & + bind(c, name='cv_convert_doubles') + import :: c_double, c_int, c_ptr + type(c_ptr), value, intent(in) :: converter + real(c_double), intent(in) :: in_(*) + integer(c_int), value, intent(in) :: count_ + real(c_double), intent(out) :: out_(count_) + end subroutine cv_convert_doubles + + ! Use converter to convert in_ and put it in out_. + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + subroutine cv_convert_floats(converter, in_, count_, out_) & + bind(c, name='cv_convert_floats') + import :: c_ptr, c_float, c_int + type(c_ptr), value, intent(in) :: converter + real(c_float), intent(in) :: in_(*) + integer(c_int), value, intent(in) :: count_ + real(c_float), intent(out) :: out_(count_) + end subroutine cv_convert_floats + + ! Return type(c_ptr) to ut_unit + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + ! Use ut_get_status to check error condition. + type(c_ptr) function ut_parse(system, string, encoding) & + bind(c, name='ut_parse') + import :: c_ptr, c_char, ut_encoding + type(c_ptr), value, intent(in) :: system + character(c_char), intent(in) :: string(*) + integer(ut_encoding), value, intent(in) :: encoding + end function ut_parse + + ! Free memory for ut_system + subroutine ut_free_system(system) bind(c, name='ut_free_system') + import :: c_ptr + type(c_ptr), value :: system + end subroutine ut_free_system + + ! Free memory for ut_unit + subroutine ut_free(unit) bind(c, name='ut_free') + import :: c_ptr + type(c_ptr), value :: unit + end subroutine ut_free + + ! Free memory for cv_converter + subroutine cv_free(conv) bind(c, name='cv_free') + import :: c_ptr + type(c_ptr), value :: conv + end subroutine cv_free + + ! Set udunits error handler to ut_ignore (do nothing) + subroutine ut_set_ignore_error_message_handler() & + bind(c, name='ut_set_ignore_error_message_handler') + end subroutine ut_set_ignore_error_message_handler + + end interface + +end module ud2f_interfaces diff --git a/udunits2f/status_codes.F90 b/udunits2f/status_codes.F90 new file mode 100644 index 000000000000..d57338aeb5c8 --- /dev/null +++ b/udunits2f/status_codes.F90 @@ -0,0 +1,37 @@ +! Status values for udunits2 procedures +! The values are the same as the udunits2 utStatus C enum +module ud2f_status_codes + + implicit none + + enum, bind(c) + enumerator :: & + UT_SUCCESS = 0, & ! Success + UT_BAD_ARG, & ! An argument violates the function's contract + UT_EXISTS, & ! Unit, prefix, or identifier already exists + UT_NO_UNIT, & ! No such unit exists + UT_OS, & ! Operating-system error. See "errno". + UT_NOT_SAME_SYSTEM, & ! The units belong to different unit-systems + UT_MEANINGLESS, & ! The operation on the unit(s) is meaningless + UT_NO_SECOND, & ! The unit-system doesn't have a unit named "second" + UT_VISIT_ERROR, & ! An error occurred while visiting a unit + UT_CANT_FORMAT, & ! A unit can't be formatted in the desired manner + UT_SYNTAX, & ! string unit representation contains syntax error + UT_UNKNOWN, & ! string unit representation contains unknown word + UT_OPEN_ARG, & ! Can't open argument-specified unit database + UT_OPEN_ENV, & ! Can't open environment-specified unit database + UT_OPEN_DEFAULT, & ! Can't open installed, default, unit database + UT_PARSE_ERROR ! Error parsing unit specification + end enum + integer, parameter :: ut_status = kind(UT_SUCCESS) + + enum, bind(c) + enumerator :: & + UTF_DUPLICATE_INITIALIZATION = 100, & + UTF_CONVERTER_NOT_INITIALIZED, & + UTF_NOT_INITIALIZED, & + UTF_INITIALIZATION_FAILURE + + end enum + +end module ud2f_status_codes diff --git a/udunits2f/tests/CMakeLists.txt b/udunits2f/tests/CMakeLists.txt new file mode 100644 index 000000000000..7b5be2e4b42a --- /dev/null +++ b/udunits2f/tests/CMakeLists.txt @@ -0,0 +1,26 @@ +set(MODULE_DIRECTORY "${esma_include}/udunits2f.tests") + +set (test_srcs + Test_UDSystem.pf + Test_udunits2f.pf + ) + +add_pfunit_ctest(udunits2f.tests + TEST_SOURCES ${test_srcs} + LINK_LIBRARIES udunits2f + ) +set_target_properties(udunits2f.tests PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) +set_tests_properties(udunits2f.tests PROPERTIES LABELS "ESSENTIAL") + +# With this test, it was shown that if you are building with the GNU Fortran +# compiler and *not* on APPLE, then you need to link with the dl library. +if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU" AND NOT APPLE) + target_link_libraries(udunits2f.tests ${CMAKE_DL_LIBS}) +endif () + +# This test requires UDUNITS2_XML_PATH to be set to the location of the udunits2.xml file +# This is found by Findudunits.cmake and stored in the variable udunits_XML_PATH +set_tests_properties(udunits2f.tests PROPERTIES ENVIRONMENT "UDUNITS2_XML_PATH=${udunits_XML_PATH}") + +add_dependencies(build-tests udunits2f.tests) + diff --git a/udunits2f/tests/Test_UDSystem.pf b/udunits2f/tests/Test_UDSystem.pf new file mode 100644 index 000000000000..14f8979a656d --- /dev/null +++ b/udunits2f/tests/Test_UDSystem.pf @@ -0,0 +1,120 @@ +module Test_UDsystem + + use funit + use ud2f_UDSystem, finalize_udunits_system => finalize, initialize_udunits_system => initialize + use udunits2f + use iso_c_binding, only: c_ptr, c_double, c_float, c_associated + + implicit none + + integer(ut_encoding), parameter :: ENCODING = UT_ASCII + character(len=*), parameter :: KM = 'km' + character(len=*), parameter :: M = 'm' + character(len=*), parameter :: S = 's' + +contains + + @Test + subroutine test_get_converter() + type(Converter) :: conv + type(c_ptr) :: cptr + integer(ut_status) :: status + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, KM, M, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + @assertFalse(conv%is_free(), 'cv_converter is not set') + cptr = conv%get_cptr() + @assertTrue(c_associated(cptr), 'c_ptr is not associated') + + call conv%free() + call finalize_udunits_system() + + end subroutine test_get_converter + + @Test + subroutine test_convert_double() + real(c_double), parameter :: FROM = 1.0 + real(c_double), parameter :: EXPECTED = 1000.0 + real(c_double) :: actual + type(Converter) :: conv + integer(ut_status) :: status + character(len=*), parameter :: FROM_STRING = KM + character(len=*), parameter :: TO_STRING = M + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, FROM_STRING, TO_STRING, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + actual = conv%convert(FROM) + @assertEqual(actual, EXPECTED, 'Actual does not equal expected.') + call conv%free() + call finalize_udunits_system() + + end subroutine test_convert_double + + @Test + subroutine test_convert_float() + real(c_float), parameter :: FROM = 1.0 + real(c_float), parameter :: EXPECTED = 1000.0 + real(c_float) :: actual + type(Converter) :: conv + integer(ut_status) :: status + character(len=*), parameter :: FROM_STRING = KM + character(len=*), parameter :: TO_STRING = M + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, FROM_STRING, TO_STRING, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + actual = conv%convert(FROM) + @assertEqual(actual, EXPECTED, 'Actual does not equal expected.') + call conv%free() + call finalize_udunits_system() + + end subroutine test_convert_float + + @Test + subroutine test_convert_doubles() + real(c_double), parameter :: FROM(3) = [1.0, 2.0, 3.0] + real(c_double), parameter :: EXPECTED(3) = 1000.0 * FROM + real(c_double) :: actual(size(EXPECTED)) + type(Converter) :: conv + integer(ut_status) :: status + character(len=*), parameter :: FROM_STRING = KM + character(len=*), parameter :: TO_STRING = M + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, FROM_STRING, TO_STRING, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + actual = conv%convert(FROM) + @assertEqual(actual, EXPECTED, 'Actual does not equal expected.') + call conv%free() + call finalize_udunits_system() + + end subroutine test_convert_doubles + + @Test + subroutine test_convert_floats() + real(c_float), parameter :: FROM(3) = [1.0, 2.0, 3.0] + real(c_float), parameter :: EXPECTED(3) = 1000.0 * FROM + real(c_float) :: actual(size(EXPECTED)) + type(Converter) :: conv + integer(ut_status) :: status + character(len=*), parameter :: FROM_STRING = KM + character(len=*), parameter :: TO_STRING = M + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, FROM_STRING, TO_STRING, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + actual = conv%convert(FROM) + @assertEqual(actual, EXPECTED, 'Actual does not equal expected.') + call conv%free() + call finalize_udunits_system() + + end subroutine test_convert_floats + +end module Test_UDsystem diff --git a/udunits2f/tests/Test_udunits2f.pf b/udunits2f/tests/Test_udunits2f.pf new file mode 100644 index 000000000000..ec51c125b14c --- /dev/null +++ b/udunits2f/tests/Test_udunits2f.pf @@ -0,0 +1,167 @@ +module Test_udunits2f + + use funit + use ud2f_UDSystem, finalize_udunits_system => finalize, initialize_udunits_system => initialize + use udunits2f + use iso_c_binding, only: c_ptr, c_associated, c_char, c_null_char + + implicit none + + integer(ut_encoding), parameter :: ENCODING = UT_ASCII + character(len=*), parameter :: KM = 'km' + character(len=*), parameter :: M = 'm' + character(len=*), parameter :: S = 's' + +contains + + @Test + subroutine test_construct_system_no_path() + type(UDSystem) :: wrapper + + wrapper = UDSystem() + @assertFalse(wrapper%is_free(), 'ut_system is not set') + call ut_free_system(wrapper%get_cptr()) + + end subroutine test_construct_system_no_path + + @Test + subroutine test_cptr_wrapper() + type(UDSystem) :: wrapper + type(c_ptr) :: cptr + logical :: cassoc + + wrapper = UDSystem() + cptr = wrapper%get_cptr() + cassoc = c_associated(cptr) + @assertTrue(cassoc, 'Did not get c_ptr') + if(cassoc) then + @assertFalse(wrapper%is_free(), 'c_ptr should be set.') + call wrapper%free() + cptr = wrapper%get_cptr() + @assertFalse(c_associated(cptr), 'c_ptr should not be associated') + @assertTrue(wrapper%is_free(), 'c_ptr should not be set') + end if + if(c_associated(cptr)) call ut_free_system(cptr) + + end subroutine test_cptr_wrapper + + @Test + subroutine test_construct_unit() + type(UDUnit) :: unit1 + integer(ut_status) :: status + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + unit1 = UDUnit(KM) + @assertFalse(unit1%is_free(), 'ut_unit is not set (default encoding)') + + call unit1%free() + call finalize_udunits_system() + + end subroutine test_construct_unit + + @Test + subroutine test_construct_converter() + type(UDUnit) :: unit1 + type(UDUnit) :: unit2 + type(Converter) :: conv + integer(ut_status) :: status + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + unit1 = UDUnit(KM) + unit2 = UDUnit(M) + conv = Converter(unit1, unit2) + @assertFalse(conv%is_free(), 'cv_converter is not set') + + call unit1%free() + call unit2%free() + call conv%free() + call finalize_udunits_system() + + end subroutine test_construct_converter + + @Test + subroutine test_read_xml_nopath() + integer :: status + type(c_ptr) :: utsystem + + call read_xml(utsystem=utsystem, status=status) + if(.not. c_associated(utsystem)) then + @assertFalse(status == UT_OS, 'Operating system error') + @assertFalse(status == UT_PARSE_ERROR, 'Database file could not be parsed.') + @assertFalse(status == UT_OPEN_ARG, 'Non-null path could not be opened.') + @assertFalse(status == UT_OPEN_ENV, 'Environment variable is set but could not open.') + @assertFalse(status == UT_OPEN_DEFAULT, 'Default database could not be opened.') + end if + + call ut_free_system(utsystem) + + end subroutine test_read_xml_nopath + + @Test + subroutine test_cstring() + character(len=*), parameter :: fs = 'FOO_BAR' + character(kind=c_char, len=80) :: cchs + character(kind=kind(cchs)) :: cc + integer :: n + + cchs = cstring(fs) + @assertEqual(kind((cchs)), c_char, 'Wrong kind') + n = len_trim(cchs) + @assertEqual(n, len(fs)+1, 'cstring is incorrect length.') + cc = cchs(n:n) + @assertEqual(cc, c_null_char, 'Final character is not null.') + @assertEqual(cchs(1:(n-1)), fs, 'Initial characters do not match.') + + end subroutine test_cstring + + @Test + subroutine test_are_convertible() + type(UDUnit) :: unit1 + type(UDUnit) :: unit2 + integer(ut_status) :: status + logical :: convertible + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + unit1 = UDUnit(KM) + unit2 = UDUnit(M) + convertible = are_convertible(unit1, unit2, rc=status) + if(.not. convertible) then + @assertFalse(status == UT_BAD_ARG, 'One of the units is null.') + @assertFalse(status == UT_NOT_SAME_SYSTEM, 'Units belong to different systems.') + end if + + call unit1%free() + call unit2%free() + call finalize_udunits_system() + + end subroutine test_are_convertible + + @Test + subroutine test_are_not_convertible() + type(UDUnit) :: unit1 + type(UDUnit) :: unit2 + integer(ut_status) :: status + logical :: convertible + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + unit1 = UDUnit(KM) + unit2 = UDUnit(S) + convertible = are_convertible(unit1, unit2, rc=status) + @assertFalse(convertible, 'Units are not convertible.') + if(.not. convertible) then + @assertFalse(status == UT_BAD_ARG, 'One of the units is null.') + @assertFalse(status == UT_NOT_SAME_SYSTEM, 'Units belong to different systems.') + @assertTrue(status == UT_SUCCESS, 'Units are not convertible.') + end if + + call unit1%free() + call unit2%free() + call finalize_udunits_system() + + end subroutine test_are_not_convertible + +end module Test_udunits2f diff --git a/udunits2f/udunits2f.F90 b/udunits2f/udunits2f.F90 new file mode 100644 index 000000000000..e6d07b2ff8a2 --- /dev/null +++ b/udunits2f/udunits2f.F90 @@ -0,0 +1,6 @@ +module udunits2f + use ud2f_interfaces + use ud2f_encoding + use ud2f_status_codes + use ud2f_UDsystem +end module udunits2f diff --git a/udunits2f/ut_set_ignore_error_message_handler.c b/udunits2f/ut_set_ignore_error_message_handler.c new file mode 100644 index 000000000000..f20637a5140c --- /dev/null +++ b/udunits2f/ut_set_ignore_error_message_handler.c @@ -0,0 +1,16 @@ +#include +#include +#include "udunits2.h" + +/* Helper function to augment udunits2 error handling + * Sets the udunits2 error handler to ut_ignore + * which disables error messages from udunits2 + * udunits2 requires a ut_error_message_handler be passed + * into ut_set_error_message_handler to change the error handler, + * and ut_error_message_handler is a function with a variadic list + * of arguments, which is not possible in Fortran. +*/ +ut_error_message_handler ut_set_ignore_error_message_handler() +{ + return ut_set_error_message_handler(ut_ignore); +}