diff --git a/.circleci/config.yml b/.circleci/config.yml index 2321066747f7..c8f8f3ee4be6 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -211,7 +211,7 @@ workflows: baselibs_version: *baselibs_version repo: GEOSadas checkout_fixture: true - #fixture_branch: feature/mathomp4/ignore-heldsuarez + fixture_branch: feature/mathomp4/mapldevelop checkout_mapl_branch: true mepodevelop: false rebuild_procs: 1 diff --git a/CHANGELOG.md b/CHANGELOG.md index f63b86bde598..f6aa08f82101 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,13 +9,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Add new benchmark to simulation writing a cubed-sphere file using various tunable strategies +- New directory (`docs/tutorial/grid_comps/automatic_code_generator`) containing an example showing how to automatically generate the source code using the `MAPL_GridCompSpecs_ACG.py` tool. ### Changed -- Modified fpp macro `_UNUSED_DUMMY(x) to use ASSOCIATE instead of PRINT. With this change it can be used in PURE procedures. -- Make error handling in Plain_netCDF_Time consistent with MAPL standard error handling -- Extend unit tests for FileSystemUtilities. -- Updated handling of NetCDF time values ### Fixed @@ -23,11 +19,37 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated -## 2023-10-27 +## [2.42.0] - 2023-10-27 ### Added -- New directory (`docs/tutorial/grid_comps/automatic_code_generator`) containing an example showing how to automatically generate the source code using the `MAPL_GridCompSpecs_ACG.py` tool. +- Various workarounds for building MAPL with MPICH + - Non-support for `C_PTR` in `MPI_Alloc_Mem` ((MPICH Issue #6691)[https://github.com/pmodels/mpich/issues/6691]) + - Non-support for `ierror` keyword arguments with `use mpi` ((MPICH Issue #6693)[https://github.com/pmodels/mpich/issues/6693]) +- Add new benchmark to simulation writing a cubed-sphere file using various tunable strategies + +### Changed + +- Modified fpp macro `_UNUSED_DUMMY(x)` to use ASSOCIATE instead of PRINT. With this change it can be used in PURE procedures. +- Make error handling in Plain_netCDF_Time consistent with MAPL standard error handling +- Extend unit tests for FileSystemUtilities. +- Updated handling of NetCDF time values +- Update `components.yaml` + - ESMA_cmake v3.36.0 (Support for SLES15 at NCCS, support for Intel 2021.10) + - ESMA_env v4.20.5 (Support for SLES15 at NCCS) + +### Fixed + +- Introduced workaround for Intel 2021.10 bug in generic layer. +- Updated write_by_oserver logic so that the decision to write by the oserver is based on whether the output server client is passed in +- Updated CI GEOSadas build to use special branch (as stock ADAS at the moment is too far behind GEOSgcm main) +- Fix incorrect History print during runtime + +## [2.41.2] - 2023-10-27 + +### Fixed + +- Fixed missing initialize of pFlogger in a pfio test. Not clear why this was not failing for other compilers - detected with ifort 2021.10.0. ## [2.41.1] - 2023-10-04 diff --git a/CMakeLists.txt b/CMakeLists.txt index ea3eb9110d46..01c558963df2 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.41.1 + VERSION 2.42.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui @@ -216,6 +216,16 @@ add_subdirectory (Apps) add_subdirectory (MAPL_cfio MAPL_cfio_r4) add_subdirectory (MAPL_cfio MAPL_cfio_r8) +# This tests for various capabilities of the compiler +# We mainly use it for MPICH issues +include(CheckCompilerCapabilities) + +# 1. The first workaround is in pfio for https://github.com/pmodels/mpich/issues/6691 +# 2. Below is to workaround https://github.com/pmodels/mpich/issues/6693 +if(SUPPORT_FOR_MPI_IERROR_KEYWORD) + add_compile_definitions(SUPPORT_FOR_MPI_IERROR_KEYWORD) +endif() + add_subdirectory (pfio) add_subdirectory (profiler) add_subdirectory (generic) diff --git a/README.md b/README.md index b678f1ee1666..0d35086d038f 100644 --- a/README.md +++ b/README.md @@ -33,6 +33,7 @@ MAPL also has a variety of other auxiliary directories: 9. **docs** - documentation ## Using MAPL + You can find simple examples on how to use MAPL components in ESMF applications at: [MAPL Tutorial](https://github.com/GEOS-ESM/MAPL/blob/main/docs/tutorial/README.md) diff --git a/base/NCIO.F90 b/base/NCIO.F90 index 9867d57907d7..90394334a0ba 100644 --- a/base/NCIO.F90 +++ b/base/NCIO.F90 @@ -312,6 +312,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients type (ESMF_DistGrid) :: distGrid type (LocalMemReference) :: lMemRef integer :: size_1d + logical :: have_oclients call ESMF_FieldGet(field, grid=grid, rc=status) _VERIFY(STATUS) @@ -320,9 +321,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call ESMF_DistGridGet(distGrid, delayout=layout, rc=STATUS) _VERIFY(STATUS) - if( arrdes%write_restart_by_oserver) then - _ASSERT(present(oClients), "output server is needed") - endif + have_oclients = present(oClients) call ESMF_AttributeGet(field, name='DIMS', value=DIMS, rc=status) _VERIFY(STATUS) @@ -351,7 +350,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients size_1d = size(var_1d,1) endif - if (arrdes%write_restart_by_oserver) then + if (have_oclients) then if( MAPL_AM_I_ROOT()) then lMemRef = LocalMemReference(pFIO_REAL32,[size_1d]) call c_f_pointer(lMemRef%base_address, gvar_1d, shape=[size_1d]) @@ -390,7 +389,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients size_1d = size(vr8_1d,1) endif - if (arrdes%write_restart_by_oserver) then + if (have_oclients) then if(MAPL_AM_I_ROOT()) then lMemRef = LocalMemReference(pFIO_REAL64,[size_1d]) call c_f_pointer(lMemRef%base_address, gvr8_1d, shape=[size_1d]) @@ -428,7 +427,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients if (associated(var_2d)) then !ALT: temp kludge if (DIMS == MAPL_DimsTileOnly .or. DIMS == MAPL_DimsTileTile) then - if (arrdes%write_restart_by_oserver) then + if (have_oclients) then if(MAPL_AM_I_ROOT()) then lMemRef = LocalMemReference(pFIO_REAL32,[arrdes%im_world, size(var_2d,2)]) call c_f_pointer(lMemRef%base_address, gvar_2d, shape=[arrdes%im_world, size(var_2d,2)]) @@ -462,7 +461,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients if (associated(vr8_2d)) then !ALT: temp kludge if (DIMS == MAPL_DimsTileOnly .or. DIMS == MAPL_DimsTileTile) then - if (arrdes%write_restart_by_oserver) then + if (have_oclients) then if( MAPL_AM_I_ROOT() ) then lMemRef = LocalMemReference(pFIO_REAL64,[arrdes%im_world,size(vr8_2d,2)]) call c_f_pointer(lMemRef%base_address, gvr8_2d, shape=[arrdes%im_world,size(vr8_2d,2)]) @@ -497,7 +496,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients if (associated(var_3d)) then !ALT: temp kludge if (DIMS == MAPL_DimsTileOnly) then - if (arrdes%write_restart_by_oserver) then + if (have_oclients) then if( MAPL_Am_I_Root() ) then lMemRef = LocalMemReference(pFIO_REAL32,[arrdes%im_world, size(var_3d,2), size(var_3d,3)]) call c_f_pointer(lMemRef%base_address, gvar_3d, shape=[arrdes%im_world, size(var_3d,2), size(var_3d,3)]) @@ -536,7 +535,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients if (associated(vr8_3d)) then !ALT: temp kludge if (DIMS == MAPL_DimsTileOnly) then - if (arrdes%write_restart_by_oserver) then + if (have_oclients) then if( MAPL_Am_I_Root() ) then lMemRef = LocalMemReference(pFIO_REAL64,[arrdes%im_world,size(vr8_3d,2), size(vr8_3d,3)]) call c_f_pointer(lMemRef%base_address, gvr8_3d, shape=[arrdes%im_world,size(vr8_3d,2), size(vr8_3d,3)]) @@ -619,8 +618,7 @@ subroutine MAPL_VarWriteNCpar_R4_4d(formatter, name, A, ARRDES, oClients, RC) type(ArrayReference) :: ref if (present(arrdes)) then - if (arrdes%write_restart_by_oserver) then - _ASSERT(present(oClients), "output server is needed") + if (present(oClients)) then call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn) @@ -670,8 +668,7 @@ subroutine MAPL_VarWriteNCpar_R8_4d(formatter, name, A, ARRDES, oClients, RC) integer :: i1, j1, in, jn, global_dim(3) type(ArrayReference) :: ref - if (arrdes%write_restart_by_oserver) then - _ASSERT(present(oClients), "output server is needed") + if (present(oClients)) then call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn) @@ -712,8 +709,7 @@ subroutine MAPL_VarWriteNCpar_R4_3d(formatter, name, A, ARRDES, oClients, RC) type(ArrayReference) :: ref if (present(arrdes)) then - if (arrdes%write_restart_by_oserver) then - _ASSERT(present(oClients), "output server is needed") + if (present(oclients)) then call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn) @@ -780,8 +776,7 @@ subroutine MAPL_VarWriteNCpar_R8_3d(formatter, name, A, ARRDES, oClients, RC) type(ArrayReference) :: ref - if (arrdes%write_restart_by_oserver) then - _ASSERT(present(oClients), "outpur server is needed") + if (present(oclients)) then call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn) @@ -852,8 +847,7 @@ subroutine MAPL_VarWriteNCpar_R4_2d(formatter, name, A, ARRDES, lev, offset2, oC integer :: i1, j1, in, jn, global_dim(3) if (present(arrdes)) then - if(arrdes%write_restart_by_oserver) then - _ASSERT(present(oClients), "output server is needed") + if(present(oClients)) then call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn) @@ -2342,8 +2336,7 @@ subroutine MAPL_VarWriteNCpar_R8_2d(formatter, name, A, ARRDES, lev, offset2, oC integer :: i1, j1, in, jn, global_dim(3) if (present(arrdes)) then - if( arrdes%write_restart_by_oserver) then - _ASSERT(present(oClients), "output server is needed") + if(present(oClients)) then call MAPL_GridGet(arrdes%grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) call MAPL_Grid_interior(arrdes%grid,i1,in,j1,jn) @@ -3274,8 +3267,9 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) character(len=ESMF_MAXSTR) :: positive type(StringVector) :: flip_vars type(ESMF_Field) :: lons_field, lats_field - logical :: isGridCapture + logical :: isGridCapture, have_oclients real(kind=ESMF_KIND_R8), pointer :: grid_lons(:,:), grid_lats(:,:), lons_field_ptr(:,:), lats_field_ptr(:,:) + have_oclients = present(oClients) call ESMF_FieldBundleGet(Bundle,FieldCount=nVars, name=BundleName, rc=STATUS) _VERIFY(STATUS) @@ -3471,7 +3465,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) ndims = ndims + 1 !WJ note: if arrdes%write_restart_by_oserver is true, all processors will participate - if (arrdes%writers_comm/=MPI_COMM_NULL .or. arrdes%write_restart_by_oserver) then + if (arrdes%writers_comm/=MPI_COMM_NULL .or. have_oclients ) then ! Create dimensions as needed if (Have_HorzVert .or. Have_HorzOnly) then @@ -3832,8 +3826,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) _VERIFY(STATUS) - if (arrdes%write_restart_by_oserver) then - _ASSERT(present(oClients), 'output server is needed') + if (have_oclients) then call oClients%set_optimal_server(1) iter = RstCollections%find(trim(BundleName)) if (iter == RstCollections%end()) then @@ -3935,7 +3928,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call MAPL_FieldWriteNCPar(formatter, 'lats', lats_field, arrdes, HomePE=mask, oClients=oClients, rc=status) end if - if (arrdes%write_restart_by_oserver) then + if (have_oclients) then call oClients%done_collective_stage(_RC) call oClients%post_wait() call MPI_Info_free(info, status) diff --git a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 index 353ad216c854..c82f395c3c11 100644 --- a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 +++ b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 @@ -719,7 +719,10 @@ program checkpoint_tester write(*,'(A,I3)')"Num writers: ",support%num_writers write(*,'(A,I6)')"Total cores: ",comm_size write(*,'(A,I6,I6)')"Cube size: ",support%im_world,support%lm - write(*,'(A,L,L,L,L,L,L,L)')"Split file, 3D_gather, chunk, extra, netcdf output, write barrier, do writes: ",support%split_file,support%gather_3d,support%do_chunking,support%extra_info,support%netcdf_writes,support%write_barrier,support%do_writes + write(*,'(A,7(L1))')"Split file, 3D_gather, chunk, extra, netcdf output, write barrier, do writes: ",& + support%split_file, support%gather_3d, & + support%do_chunking,support%extra_info, & + support%netcdf_writes,support%write_barrier, support%do_writes write(*,'(A,I6)')"Number of trial: ",support%n_trials write(*,'(A,G16.8)')"Application time: ",application_time end if diff --git a/cmake/CheckCompilerCapabilities.cmake b/cmake/CheckCompilerCapabilities.cmake new file mode 100644 index 000000000000..bd1b773cb7e0 --- /dev/null +++ b/cmake/CheckCompilerCapabilities.cmake @@ -0,0 +1,27 @@ +include (CheckFortranSource) + +CHECK_FORTRAN_SOURCE_COMPILE ( + ${CMAKE_CURRENT_LIST_DIR}/support_for_assumed_type.F90 + SUPPORT_FOR_ASSUMED_TYPE +) + +CHECK_FORTRAN_SOURCE_COMPILE ( + ${CMAKE_CURRENT_LIST_DIR}/support_for_c_loc_assumed_size.F90 + SUPPORT_FOR_C_LOC_ASSUMED_SIZE +) + +CHECK_FORTRAN_SOURCE_COMPILE ( + ${CMAKE_CURRENT_LIST_DIR}/support_for_mpi_alloc_mem_cptr.F90 + SUPPORT_FOR_MPI_ALLOC_MEM_CPTR + MPI +) + +CHECK_FORTRAN_SOURCE_COMPILE ( + ${CMAKE_CURRENT_LIST_DIR}/support_for_mpi_ierror_keyword.F90 + SUPPORT_FOR_MPI_IERROR_KEYWORD + MPI +) + + + + diff --git a/cmake/CheckFortranSource.cmake b/cmake/CheckFortranSource.cmake new file mode 100644 index 000000000000..3f2982abf6ec --- /dev/null +++ b/cmake/CheckFortranSource.cmake @@ -0,0 +1,83 @@ +macro (CHECK_FORTRAN_SOURCE_COMPILE file var) + + if (NOT CMAKE_REQUIRED_QUIET) + message (STATUS "Performing Test ${var}") + endif () + + if (${ARGC} GREATER 2) + try_compile ( + ${var} + ${CMAKE_BINARY_DIR} + ${file} + CMAKE_FLAGS "-DCOMPILE_DEFINITIONS:STRING=${MPI_Fortran_FLAGS}" + "-DINCLUDE_DIRECTORIES:LIST=${MPI_Fortran_INCLUDE_DIRS}" + "-DLINK_LIBRARIES:LIST=${MPI_Fortran_LIBRARIES}" + ) + else () + + try_compile ( + ${var} + ${CMAKE_BINARY_DIR} + ${file} + ) + endif () + + if (${var}) + if (NOT CMAKE_REQUIRED_QUIET) + message(STATUS "Performing Test ${var}: SUCCESS") + endif () + + add_definitions(-D${var}) + + else () + + if (NOT CMAKE_REQUIRED_QUIET) + message(STATUS "Performing Test ${var}: FAILURE") + endif () + + endif () + +endmacro (CHECK_FORTRAN_SOURCE_COMPILE) + + +macro (CHECK_FORTRAN_SOURCE_RUN file var) + + if (NOT CMAKE_REQUIRED_QUIET) + message (STATUS "Performing Test ${var}") + endif () + + try_run ( + code_runs + code_compiles + ${CMAKE_BINARY_DIR} + ${file} + ) + + if (${code_compiles}) + if (${code_runs} EQUAL 0) + + if (NOT CMAKE_REQUIRED_QUIET) + message (STATUS "Performing Test ${var}: SUCCESS") + endif () + + add_definitions(-D${var}) + + set (${var} 1) + + else () + + if (NOT CMAKE_REQUIRED_QUIET) + message (STATUS "Performing Test ${var}: RUN FAILURE") + endif () + + endif () + + else () + + if (NOT CMAKE_REQUIRED_QUIET) + message (STATUS "Performing Test ${var}: BUILD FAILURE") + endif () + + endif() + +endmacro (CHECK_FORTRAN_SOURCE_RUN) diff --git a/cmake/support_for_assumed_type.F90 b/cmake/support_for_assumed_type.F90 new file mode 100644 index 000000000000..e3e3d0868391 --- /dev/null +++ b/cmake/support_for_assumed_type.F90 @@ -0,0 +1,5 @@ +subroutine foo(x) + type(*) :: x(*) +end subroutine foo +program main +end program main diff --git a/cmake/support_for_c_loc_assumed_size.F90 b/cmake/support_for_c_loc_assumed_size.F90 new file mode 100644 index 000000000000..0d52420705f0 --- /dev/null +++ b/cmake/support_for_c_loc_assumed_size.F90 @@ -0,0 +1,10 @@ +subroutine foo(x) + use iso_c_binding + real, target :: x(*) + type (C_PTR) :: loc + loc = c_loc(x(1)) +end subroutine foo + +program main +end program main + diff --git a/cmake/support_for_mpi_alloc_mem_cptr.F90 b/cmake/support_for_mpi_alloc_mem_cptr.F90 new file mode 100644 index 000000000000..ce30fb032f48 --- /dev/null +++ b/cmake/support_for_mpi_alloc_mem_cptr.F90 @@ -0,0 +1,12 @@ +program main + use mpi + use iso_fortran_env, only: INT64 + use iso_c_binding, only: C_PTR + + integer(kind=INT64) :: sz + type (c_ptr) :: ptr + + call MPI_Alloc_mem(sz, MPI_INFO_NULL, ptr, ierror) + +end program main + diff --git a/cmake/support_for_mpi_ierror_keyword.F90 b/cmake/support_for_mpi_ierror_keyword.F90 new file mode 100644 index 000000000000..02bdaf2dcfc6 --- /dev/null +++ b/cmake/support_for_mpi_ierror_keyword.F90 @@ -0,0 +1,7 @@ +program main + use mpi + implicit none + integer :: status + call MPI_Init(ierror=status) +end program main + diff --git a/components.yaml b/components.yaml index aac5a6e23adf..970c7762769f 100644 --- a/components.yaml +++ b/components.yaml @@ -5,13 +5,13 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v4.19.0 + tag: v4.20.5 develop: main ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.34.0 + tag: v3.36.0 develop: develop ecbuild: diff --git a/generic/AbstractComponent.F90 b/generic/AbstractComponent.F90 index eb02ea5d9950..094333e88616 100644 --- a/generic/AbstractComponent.F90 +++ b/generic/AbstractComponent.F90 @@ -96,7 +96,7 @@ subroutine i_RunChild(this, name, clock, phase, unusable, rc) end subroutine i_RunChild subroutine i_SetLogger(this, logger) - use pFlogger, only: t_Logger => Logger + use pfl_logger, only: t_Logger => Logger import AbstractComponent implicit none class(AbstractComponent), intent(inout) :: this @@ -105,7 +105,7 @@ subroutine i_SetLogger(this, logger) end subroutine i_SetLogger function i_GetLogger(this) result(logger) - use pFlogger, only: t_Logger => Logger + use pfl_logger, only: t_Logger => Logger import AbstractComponent implicit none class(t_Logger), pointer :: logger diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 319efca86183..fe19ebff2c3f 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -2019,14 +2019,12 @@ subroutine capture(POS, PHASE, GC, IMPORT, EXPORT, CLOCK, RC) write(phase_, '(i1)') phase call MAPL_ESMFStateWriteToFile(import, CLOCK, trim(FILENAME)//"import_"//trim(POS)//"_runPhase"//phase_, & - FILETYPE, STATE, .false., _RC) - + FILETYPE, STATE, .false., state%grid%write_restart_by_oserver, _RC) call MAPL_ESMFStateWriteToFile(export, CLOCK, trim(FILENAME)//"export_"//trim(POS)//"_runPhase"//phase_, & - FILETYPE, STATE, .false., oClients = o_Clients, _RC) - + FILETYPE, STATE, .false., state%grid%write_restart_by_oserver, _RC) call MAPL_GetResource(STATE, hdr, default=0, LABEL="INTERNAL_HEADER:", _RC) call MAPL_ESMFStateWriteToFile(internal, CLOCK, trim(FILENAME)//"internal_"//trim(POS)//"_runPhase"//phase_, & - FILETYPE, STATE, hdr/=0, oClients = o_Clients, _RC) + FILETYPE, STATE, hdr/=0, state%grid%write_restart_by_oserver, _RC) end if _RETURN(_SUCCESS) end subroutine capture @@ -2407,7 +2405,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(status) internal_state => state%get_internal_state() call MAPL_ESMFStateWriteToFile(internal_state,CLOCK,FILENAME, & - FILETYPE, STATE, hdr/=0, oClients = o_Clients, RC=status) + FILETYPE, STATE, hdr/=0, state%grid%write_restart_by_oserver, RC=status) _VERIFY(status) endif @@ -2431,7 +2429,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) endif #endif call MAPL_ESMFStateWriteToFile(IMPORT,CLOCK,FILENAME, & - FILETYPE, STATE, .FALSE., oClients = o_Clients, RC=status) + FILETYPE, STATE, .FALSE., state%grid%write_restart_by_oserver, RC=status) _VERIFY(status) endif @@ -2486,7 +2484,7 @@ subroutine checkpoint_export_state(rc) endif #endif call MAPL_ESMFStateWriteToFile(EXPORT,CLOCK,FILENAME, & - FILETYPE, STATE, .FALSE., oClients = o_Clients, RC=status) + FILETYPE, STATE, .FALSE., state%grid%write_restart_by_oserver, RC=status) _VERIFY(status) endif _RETURN(_SUCCESS) @@ -2772,7 +2770,7 @@ subroutine MAPL_StateRecord( GC, IMPORT, EXPORT, CLOCK, RC ) end if call MAPL_ESMFStateWriteToFile(IMPORT, CLOCK, & STATE%RECORD%IMP_FNAME, & - FILETYPE, STATE, .FALSE., oClients = o_Clients, & + FILETYPE, STATE, .FALSE., state%grid%write_restart_by_oserver, & RC=status) _VERIFY(status) end if @@ -2789,7 +2787,7 @@ subroutine MAPL_StateRecord( GC, IMPORT, EXPORT, CLOCK, RC ) internal_state => STATE%get_internal_state() call MAPL_ESMFStateWriteToFile(internal_state, CLOCK, & STATE%RECORD%INT_FNAME, & - FILETYPE, STATE, hdr/=0, oClients = o_Clients, & + FILETYPE, STATE, hdr/=0, state%grid%write_restart_by_oserver, & RC=status) _VERIFY(status) end if @@ -5737,14 +5735,14 @@ end subroutine MAPL_GenericStateClockAdd !============================================================================= !============================================================================= - subroutine MAPL_ESMFStateWriteToFile(STATE,CLOCK,FILENAME,FILETYPE,MPL,HDR, oClients,RC) + subroutine MAPL_ESMFStateWriteToFile(STATE,CLOCK,FILENAME,FILETYPE,MPL,HDR, write_with_oserver,RC) type(ESMF_State), intent(INOUT) :: STATE type(ESMF_Clock), intent(IN ) :: CLOCK character(len=*), intent(IN ) :: FILENAME character(LEN=*), intent(INout) :: FILETYPE type(MAPL_MetaComp), intent(INOUT) :: MPL logical, intent(IN ) :: HDR - type (ClientManager), optional, intent(inout) :: oClients + logical, optional, intent(in ) :: write_with_oserver integer, optional, intent( OUT) :: RC character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_ESMFStateWriteToFile" @@ -5774,7 +5772,10 @@ subroutine MAPL_ESMFStateWriteToFile(STATE,CLOCK,FILENAME,FILETYPE,MPL,HDR, oCli !real(kind=ESMF_KIND_R8),save :: total_time = 0.0d0 !logical :: amIRoot !type (ESMF_VM) :: vm - logical :: empty + logical :: empty, local_write_with_oserver + + local_write_with_oserver=.false. + if (present(write_with_oserver)) local_write_with_oserver = write_with_oserver ! Check if state is empty. If "yes", simply return empty = MAPL_IsStateEmpty(state, _RC) @@ -5991,8 +5992,11 @@ subroutine MAPL_ESMFStateWriteToFile(STATE,CLOCK,FILENAME,FILETYPE,MPL,HDR, oCli !itime_beg = MPI_Wtime() !_VERIFY(status) - call MAPL_VarWriteNCPar(filename,STATE,ArrDes,CLOCK, oClients=oClients, RC=status) - _VERIFY(status) + if (local_write_with_oserver) then + call MAPL_VarWriteNCPar(filename,STATE,ArrDes,CLOCK, oClients=o_clients, _RC) + else + call MAPL_VarWriteNCPar(filename,STATE,ArrDes,CLOCK, _RC) + end if !call MPI_Barrier(mpl%grid%comm, status) !_VERIFY(status) @@ -10496,7 +10500,7 @@ recursive subroutine MAPL_GenericStateSave( GC, IMPORT, EXPORT, CLOCK, RC ) end if call MAPL_ESMFStateWriteToFile(IMPORT, CLOCK, & STATE%initial_state%IMP_FNAME, & - CFILETYPE, STATE, .FALSE., oClients = o_Clients, & + CFILETYPE, STATE, .FALSE., write_with_oserver = state%grid%write_restart_by_oserver, & RC=status) _VERIFY(status) end if @@ -10512,7 +10516,7 @@ recursive subroutine MAPL_GenericStateSave( GC, IMPORT, EXPORT, CLOCK, RC ) internal_state => STATE%get_internal_state() call MAPL_ESMFStateWriteToFile(internal_state, CLOCK, & STATE%initial_state%INT_FNAME, & - CFILETYPE, STATE, hdr/=0, oClients = o_Clients, & + CFILETYPE, STATE, hdr/=0, write_with_oserver = state%grid%write_restart_by_oserver, & RC=status) _VERIFY(status) end if diff --git a/gridcomps/Cap/FargparseCLI.F90 b/gridcomps/Cap/FargparseCLI.F90 index 68360a1b0a5f..48d6b5de335c 100644 --- a/gridcomps/Cap/FargparseCLI.F90 +++ b/gridcomps/Cap/FargparseCLI.F90 @@ -77,7 +77,8 @@ function new_CapOptions_from_fargparse_back_comp(unusable, extra, rc) result (fa integer, optional, intent(out) :: rc integer :: status - fargparsecap%parser = ArgParser() + call fargparsecap%parser%initialize('executable') + call fargparsecap%add_command_line_options(fargparsecap%parser, _RC) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index aba380203f23..d9356e9bb70c 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -668,7 +668,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) match = .false. contLine = .false. con3 = .false. - + do while (.true.) read(unitr, '(A)', end=1234) line j = index( adjustl(line), trim(adjustl(string)) ) @@ -677,7 +677,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) j = index(line, trim(string)//'fields:') contLine = (j > 0) k = index(line, trim(string)//'obs_files:') - con3 = (k > 0) + con3 = (k > 0) end if if (match .or. contLine .or. con3) then write(unitw,'(A)') trim(line) @@ -686,7 +686,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (adjustl(line) == '::') contLine = .false. end if if (con3) then - if (adjustl(line) == '::') con3 = .false. + if (adjustl(line) == '::') con3 = .false. endif end do @@ -883,7 +883,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetDim(cfg, nline, ncol, label=trim(string)//'obs_files:', rc=rc) ! here donot check rc on purpose if (rc==0) then if (nline > 0) then - list(n)%timeseries_output = .true. + list(n)%timeseries_output = .true. endif endif call ESMF_ConfigGetAttribute(cfg, value=list(n)%recycle_track, default=.false., & @@ -2449,7 +2449,12 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) print *, ' End_Date: ', list(n)%end_date print *, ' End_Time: ', list(n)%end_time endif - print *, ' Regrid Mthd: ', regrid_method_int_to_string(list(n)%regrid_method) + if (trim(list(n)%output_grid_label)/='') then + print *, ' Regrid Mthd: ', regrid_method_int_to_string(list(n)%regrid_method) + else + print *, ' Regrid Mthd: ', 'identity' + end if + block integer :: im_world, jm_world,dims(3) diff --git a/include/MAPL_ErrLog.h b/include/MAPL_ErrLog.h index 6dfa6d82626a..e863c1777b3f 100644 --- a/include/MAPL_ErrLog.h +++ b/include/MAPL_ErrLog.h @@ -111,7 +111,11 @@ # define _RC _RC_(rc,status) # define _STAT _RC_(stat,status) +#if defined(SUPPORT_FOR_MPI_IERROR_KEYWORD) # define _IERROR _RC_(ierror,status) +#else +# define _IERROR _RC_(ierr,status) +#endif # define _IOSTAT _RC_(iostat,status) # define _ASSERT_MSG_AND_LOC_AND_RC(A,msg,stat,file,line,rc) if(MAPL_Assert(A,msg,stat,file,line __rc(rc))) __return diff --git a/pfio/CMakeLists.txt b/pfio/CMakeLists.txt index 710718284280..6af1d06b6d7d 100644 --- a/pfio/CMakeLists.txt +++ b/pfio/CMakeLists.txt @@ -133,6 +133,10 @@ foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) target_link_libraries(${this} PRIVATE "-Xlinker -rpath -Xlinker ${dir}") endforeach() +if (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) + target_compile_definitions(${this} PRIVATE SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) +endif () + ecbuild_add_executable ( TARGET pfio_open_close.x SOURCES pfio_open_close.F90 diff --git a/pfio/DirectoryService.F90 b/pfio/DirectoryService.F90 index 6f4471ae0c19..325beb523acb 100644 --- a/pfio/DirectoryService.F90 +++ b/pfio/DirectoryService.F90 @@ -40,7 +40,7 @@ module pFIO_DirectoryServiceMod integer, parameter :: DISCOVERY_TAG = 1 ! Exchange of _root_ rank between client and server integer, parameter :: NPES_TAG = 2 ! Client sends number of pes in client to server (on roots) integer, parameter :: RANKS_TAG = 3 ! Client sends ranks of client processes to server (on roots) - integer, parameter :: CONNECT_TAG = 3 ! client and server individual processes exchange ranks + integer, parameter :: CONNECT_TAG = 3 ! client and server individual processes exchange ranks type :: DirectoryEntry sequence @@ -90,7 +90,7 @@ function new_DirectoryService(comm, unusable, rc) result(ds) integer, intent(in) :: comm class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - + integer :: ierror type (Directory) :: empty_dir @@ -118,7 +118,7 @@ function new_DirectoryService(comm, unusable, rc) result(ds) _UNUSED_DUMMY(unusable) end function new_DirectoryService - + integer function make_directory_window(comm, addr) result(win) integer, intent(in) :: comm type (c_ptr), intent(out) :: addr @@ -126,13 +126,21 @@ integer function make_directory_window(comm, addr) result(win) type (Directory), pointer :: dir type (Directory), target :: dirnull integer(kind=MPI_ADDRESS_KIND) :: sz +#if !defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) + integer(kind=MPI_ADDRESS_KIND) :: baseaddr +#endif integer :: ierror, rank call MPI_Comm_Rank(comm, rank, 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) +#else + call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, ierror) + addr = transfer(baseaddr, addr) +#endif call c_f_pointer(addr, dir) else sz = 0 @@ -142,7 +150,7 @@ integer function make_directory_window(comm, addr) result(win) call MPI_Win_create(dir, sz, 1, MPI_INFO_NULL, comm, win, ierror) end function make_directory_window - + subroutine connect_to_server(this, port_name, client, client_comm, unusable, server_size, rc) use pFIO_ClientThreadMod class (DirectoryService), target, intent(inout) :: this @@ -170,7 +178,7 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser integer :: server_npes integer, allocatable :: client_ranks(:) integer, allocatable :: server_ranks(:) - + class(ServerThread), pointer :: server_thread_ptr class(BaseServer), pointer :: server_ptr type(SimpleSocket), target :: ss @@ -226,7 +234,7 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser call MPI_Comm_rank(this%comm, dir_entry%partner_root_rank, ierror) ! global comm dir%entries(n) = dir_entry - + call this%put_directory(dir, this%win_client_directory) end if @@ -262,7 +270,7 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser call MPI_Scatter(server_ranks, 1, MPI_INTEGER, & & server_rank, 1, MPI_INTEGER, & & 0, client_comm, ierror) - + if (present(server_size)) call MPI_Bcast(server_size, 1, MPI_INTEGER, 0, client_comm,ierror) ! Construct the connection @@ -341,7 +349,7 @@ subroutine connect_to_client(this, port_name, server, rc) end if call this%mutex%release() - + if (found) then call MPI_Send(this%rank, 1, MPI_INTEGER, client_root_rank, DISCOVERY_TAG, this%comm, ierror) else @@ -418,11 +426,11 @@ subroutine publish(this, port, server, rc) type(PortInfo),target, intent(in) :: port class (BaseServer), intent(inout) :: server integer, optional, intent(out) :: rc - character(len=MAX_LEN_PORT_NAME) :: port_name + character(len=MAX_LEN_PORT_NAME) :: port_name integer :: ierror integer :: rank_in_server integer :: n - + type (Directory) :: dir type (DirectoryEntry) :: dir_entry @@ -464,7 +472,7 @@ subroutine publish(this, port, server, rc) n = dir%num_entries + 1 dir%num_entries = n - + dir_entry%port_name = port_name dir_entry%partner_root_rank = this%rank dir%entries(n) = dir_entry @@ -478,14 +486,14 @@ end subroutine publish function sizeof_directory() result(sz) integer :: sz - + integer :: sizeof_char, sizeof_integer, sizeof_DirectoryEntry integer :: one_integer character :: one_char sizeof_integer = c_sizeof(one_integer) sizeof_char = c_sizeof(one_char) - + sizeof_DirectoryEntry = MAX_LEN_PORT_NAME*sizeof_char + 1*sizeof_integer sz = sizeof_integer + MAX_NUM_PORTS*sizeof_DirectoryEntry end function sizeof_directory @@ -524,7 +532,7 @@ function get_directory(this, win) result(dir) return _UNUSED_DUMMY(this) end function get_directory - + subroutine put_directory(this, dir, win) class (DirectoryService), intent(in) :: this @@ -546,7 +554,7 @@ subroutine put_directory(this, dir, win) return _UNUSED_DUMMY(this) end subroutine put_directory - + subroutine terminate_servers(this, client_comm, rc) class (DirectoryService), intent(inout) :: this integer ,intent(in) :: client_comm @@ -554,13 +562,13 @@ subroutine terminate_servers(this, client_comm, rc) type (Directory) :: dir integer :: ierror, rank_in_client,i - + call MPI_Comm_rank(client_comm, rank_in_client, ierror) call MPI_BARRIER(client_comm,ierror) if (rank_in_client ==0) then - + write(6,*)"client0 terminates servers"; flush(6) dir = this%get_directory(this%win_server_directory) diff --git a/pfio/MpiMutex.F90 b/pfio/MpiMutex.F90 index cd3cce16780e..956638ef2102 100644 --- a/pfio/MpiMutex.F90 +++ b/pfio/MpiMutex.F90 @@ -39,6 +39,9 @@ function new_MpiMutex(comm) result(lock) integer :: ierror 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) call MPI_Comm_rank(lock%comm, lock%rank, ierror) @@ -61,10 +64,15 @@ function new_MpiMutex(comm) result(lock) block logical, pointer :: scratchpad(:) integer :: sizeof_logical - + call MPI_Type_extent(MPI_LOGICAL, sizeof_logical, 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) +#else + call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, ierror) + lock%locks_ptr = transfer(baseaddr, lock%locks_ptr) +#endif call c_f_pointer(lock%locks_ptr, scratchpad, [lock%npes]) scratchpad = .false. @@ -144,7 +152,7 @@ subroutine release(this) end if end do end if - + if (next_rank /= -1) then call MPI_Send(buffer, 0, MPI_LOGICAL, next_rank, & & LOCK_TAG, this%comm, ierror) diff --git a/pfio/RDMAReference.F90 b/pfio/RDMAReference.F90 index f692b4230a56..5b556391188a 100644 --- a/pfio/RDMAReference.F90 +++ b/pfio/RDMAReference.F90 @@ -16,8 +16,8 @@ module pFIO_RDMAReferenceMod public :: RDMAReference type,extends(AbstractDataReference) :: RDMAReference - integer :: win - integer :: comm + integer :: win + integer :: comm integer :: mem_rank integer(kind=INT64) :: msize_word logical :: RDMA_allocated = .false. @@ -106,7 +106,7 @@ subroutine deserialize(this, buffer, rc) _VERIFY(status) _RETURN(_SUCCESS) end subroutine deserialize - + subroutine allocate(this, rc) class (RDMAReference), intent(inout) :: this integer, optional, intent(out) :: rc @@ -114,22 +114,32 @@ subroutine allocate(this, rc) integer :: disp_unit,status, Rank integer(kind=MPI_ADDRESS_KIND) :: n_bytes integer :: int_size - +#if !defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) + integer(kind=MPI_ADDRESS_KIND) :: baseaddr +#endif + int_size = c_sizeof(int_size) disp_unit = int_size n_bytes = this%msize_word * int_size call MPI_Comm_rank(this%comm,Rank,status) - windowsize = 0_MPI_ADDRESS_KIND + windowsize = 0_MPI_ADDRESS_KIND if (Rank == this%mem_rank) windowsize = n_bytes - + +#if defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Win_allocate(windowsize, disp_unit, MPI_INFO_NULL, this%comm, & this%base_address, this%win, status) _VERIFY(status) +#else + call MPI_Win_allocate(windowsize, disp_unit, MPI_INFO_NULL, this%comm, & + baseaddr, this%win, status) + _VERIFY(status) + this%base_address = transfer(baseaddr, this%base_address) +#endif call MPI_Win_fence(0, this%win, status) _VERIFY(status) - + this%RDMA_allocated = .true. _RETURN(_SUCCESS) end subroutine allocate diff --git a/pfio/ShmemReference.F90 b/pfio/ShmemReference.F90 index e7e9e228d1d5..b71ced10ea91 100644 --- a/pfio/ShmemReference.F90 +++ b/pfio/ShmemReference.F90 @@ -72,7 +72,7 @@ subroutine serialize(this, buffer,rc) if(allocated(buffer)) deallocate(buffer) allocate(buffer(this%get_length())) - + call this%serialize_base(tmp_buff, rc=status) _VERIFY(status) n = this%get_length_base() @@ -102,7 +102,7 @@ subroutine deserialize(this, buffer, rc) _VERIFY(status) _RETURN(_SUCCESS) end subroutine deserialize - + subroutine allocate(this, rc) class (ShmemReference), intent(inout) :: this integer, optional, intent(out) :: rc @@ -110,22 +110,36 @@ subroutine allocate(this, rc) integer(kind=MPI_ADDRESS_KIND) :: windowsize integer :: disp_unit,ierr, InNode_Rank integer(kind=MPI_ADDRESS_KIND) :: n_bytes +#if !defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) + integer(kind=MPI_ADDRESS_KIND) :: baseaddr +#endif n_bytes = this%msize_word * 4_MPI_ADDRESS_KIND call MPI_Comm_rank(this%InNode_Comm,InNode_Rank,ierr) disp_unit = 1 - windowsize = 0_MPI_ADDRESS_KIND + windowsize = 0_MPI_ADDRESS_KIND if (InNode_Rank == 0) windowsize = n_bytes - + +#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) +#else + call MPI_Win_allocate_shared(windowsize, disp_unit, MPI_INFO_NULL, this%InNode_Comm, & + baseaddr, this%win, 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) +#else + call MPI_Win_shared_query(this%win, 0, windowsize, disp_unit, baseaddr,ierr) + this%base_address = transfer(baseaddr, this%base_address) +#endif endif - + this%shmem_allocated = .true. _RETURN(_SUCCESS) end subroutine allocate diff --git a/pfio/tests/pfio_ctest_io.F90 b/pfio/tests/pfio_ctest_io.F90 index 9e2713f499f1..ff00a0b4795c 100644 --- a/pfio/tests/pfio_ctest_io.F90 +++ b/pfio/tests/pfio_ctest_io.F90 @@ -451,6 +451,7 @@ program main use ctest_io_CLI use MAPL_ExceptionHandling use FakeHistData0Mod + use pFlogger, only: pflogger_init => initialize implicit none integer :: rank, npes, ierror, provided,required @@ -533,6 +534,7 @@ program main my_icomm = MPI_COMM_NULL my_appcomm = MPI_COMM_NULL + call pflogger_init() do i = 1, N_iclient_group low_rank = client_start + (i-1) * options%npes_iserver up_rank = client_start + i*options%npes_iserver diff --git a/pfio/tests/pfio_performance.F90 b/pfio/tests/pfio_performance.F90 index 57f6db49f850..b3fa4d515bc4 100644 --- a/pfio/tests/pfio_performance.F90 +++ b/pfio/tests/pfio_performance.F90 @@ -468,6 +468,7 @@ program main use performace_CLI use FakeHistDataMod use MAPL_ExceptionHandling + use pFlogger, only: pflogger_init => initialize implicit none integer :: rank, npes, ierror @@ -492,6 +493,7 @@ program main call process_command_line(options, rc=status) + call pflogger_init() directory_service = DirectoryService(MPI_COMM_WORLD) my_icomm = MPI_COMM_NULL