From 38bfde30e1cb8bf5222410a9c37e71529567bf69 Mon Sep 17 00:00:00 2001 From: MiKyung Lee <58964324+mlee03@users.noreply.github.com> Date: Tue, 19 Dec 2023 10:05:52 -0500 Subject: [PATCH 01/10] fix: time calculation in interpolator updates (#1429) --- interpolator/include/interpolator.inc | 8 ++------ test_fms/interpolator/test_interpolator2.F90 | 5 +---- 2 files changed, 3 insertions(+), 10 deletions(-) diff --git a/interpolator/include/interpolator.inc b/interpolator/include/interpolator.inc index c77459356..96bd7d76a 100644 --- a/interpolator/include/interpolator.inc +++ b/interpolator/include/interpolator.inc @@ -535,9 +535,7 @@ if(dimension_exists(fileobj, "time")) then ! convert file times from noleap to julian. !--------------------------------------------------------------------- else if ( (model_calendar == JULIAN .and. trim(adjustl(lowercase(file_calendar))) == 'noleap')) then - Noleap_time = set_time( INT((time_in(n)-real(INT(time_in(n)),r8_kind))*SECONDS_PER_DAY), & - INT(time_in(n))) + base_time - !Noleap_time = set_time (0, INT(time_in(n))) + base_time + Noleap_time = set_time (0, INT(time_in(n))) + base_time call get_date_no_leap (Noleap_time, yr, mo, dy, hr, mn, sc) clim_type%time_slice(n) = set_date_julian (yr, mo, dy, hr, mn, sc) if (n == 1) then @@ -554,9 +552,7 @@ if(dimension_exists(fileobj, "time")) then ! convert file times from julian to noleap. !--------------------------------------------------------------------- else if ( (model_calendar == NOLEAP .and. trim(adjustl(lowercase(file_calendar))) == 'julian')) then - Julian_time = set_time( INT( (time_in(n)-real(INT(time_in(n)),r8_kind))*SECONDS_PER_DAY), & - INT(time_in(n))) + base_time - !Julian_time = set_time (0, INT(time_in(n))) + base_time + Julian_time = set_time (0, INT(time_in(n))) + base_time call get_date_julian (Julian_time, yr, mo, dy, hr, mn, sc) clim_type%time_slice(n) = set_date_no_leap (yr, mo, dy,hr, mn, sc) if (n == 1) then diff --git a/test_fms/interpolator/test_interpolator2.F90 b/test_fms/interpolator/test_interpolator2.F90 index 0fa62c366..b202eb8b8 100644 --- a/test_fms/interpolator/test_interpolator2.F90 +++ b/test_fms/interpolator/test_interpolator2.F90 @@ -48,7 +48,7 @@ program test_interpolator2 character(100), parameter :: ncfile='immadeup.o3.climatology.nc' !< fake climatology file integer, parameter :: lkind=TEST_INTP_KIND_ !> the interpolation methods are not perfect.Will not get perfectly agreeing answers - real(r8_kind) :: tol + real(r8_kind), parameter :: tol=0.1_lkind integer :: calendar_type !> climatology related variables and arrays (made up data) @@ -90,9 +90,6 @@ program test_interpolator2 NAMELIST / test_interpolator_nml / test_file_daily_noleap, test_file_daily_julian, & test_file_yearly_noleap, test_file_yearly_julian, test_file_no_time - if(lkind==r4_kind) tol=1.e-4_r8_kind - if(lkind==r8_kind) tol=1.e-6_r8_kind - open(unit=nml_unit_var, file=nml_file) read(unit=nml_unit_var, nml=test_interpolator_nml) close(nml_unit_var) From f6710eea067b974982747b9c67a6fd4865200352 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 4 Jan 2024 12:20:44 -0500 Subject: [PATCH 02/10] fix: remove spurious warnings from mulitfile data_override update (#1431) --- data_override/include/data_override.inc | 36 ------------------------- 1 file changed, 36 deletions(-) diff --git a/data_override/include/data_override.inc b/data_override/include/data_override.inc index 8f1f49e9c..cfec9ef64 100644 --- a/data_override/include/data_override.inc +++ b/data_override/include/data_override.inc @@ -922,10 +922,6 @@ subroutine DATA_OVERRIDE_0D_(gridname,fieldname_code,data_out,time,override,data call time_interp_external(id_time,time,data_out,verbose=.false.) endif if_time2 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,data_out,verbose=.false.) endif if_multi2 @@ -1491,10 +1487,6 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time6 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi6 @@ -1533,10 +1525,6 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time7 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,1),verbose=.false., & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi7 @@ -1571,10 +1559,6 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time8 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,return_data,verbose=.false., & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi8 @@ -1607,10 +1591,6 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time9 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,return_data(startingi:endingi,startingj:endingj,:),verbose=.false., & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_multi9 @@ -1648,10 +1628,6 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time10 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) @@ -1693,10 +1669,6 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time11 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,return_data(:,:,1),verbose=.false., & horz_interp=override_array(curr_position)%horz_interp(window_id), & mask_out =mask_out(:,:,1), & @@ -1741,10 +1713,6 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time12 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,return_data,verbose=.false., & horz_interp=override_array(curr_position)%horz_interp(window_id), & is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) @@ -1783,10 +1751,6 @@ subroutine DATA_OVERRIDE_3D_(gridname,fieldname_code,return_data,time,override,d is_in=is_in,ie_in=ie_in,js_in=js_in,je_in=je_in,window_id=window_id) endif if_time13 else ! standard behavior - if ((timelast_record)) then - call mpp_error(WARNING, & - 'data_override: current time outside bounds, use [previous]:current:[next] files in data_table') - endif call time_interp_external(id_time,time,return_data,verbose=.false., & horz_interp=override_array(curr_position)%horz_interp(window_id), & mask_out =mask_out, & From c0d3845e806a30e7ca7f92f36afee8c39300b0df Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 4 Jan 2024 10:23:49 -0700 Subject: [PATCH 03/10] fix: cmake build macOS linking issues with OpenMP (#1434) --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index bb27522c8..759e6a199 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -395,7 +395,7 @@ foreach(kind ${kinds}) MPI::MPI_Fortran) if(OpenMP_Fortran_FOUND) - target_link_libraries(${libTgt} PRIVATE OpenMP::OpenMP_Fortran) + target_link_libraries(${libTgt} PRIVATE OpenMP::OpenMP_C OpenMP::OpenMP_Fortran) endif() add_library(FMS::${libTgt} ALIAS ${libTgt}) From 085c6bfc945a6f1c586b842ca6268fca442884d8 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 4 Jan 2024 12:25:42 -0500 Subject: [PATCH 04/10] docs: add documentation for xgrid (#1428) --- exchange/xgrid.F90 | 48 ++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 46 insertions(+), 2 deletions(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 3cf69cfab..4194ef274 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -2899,6 +2899,25 @@ end subroutine set_comm_put1 !############################################################################### +!> @brief Regenerate/Update the xmap +!! @details This subroutine basically regenerates the exchange grid via updating the xmap. +!! Practically xmap is the object specifying the exchange grid and has all the relevant information of Xgrid. +!! Particularly note that regenerating the xmap/Xgrid accounts for dynamical changes of the subgrid parametrization +!! of the side 2 components (land and ice-ocean). +!! E.g., for when side 2 is the ice , the xgrid is regenrated so that +!! OCN grid cells that are partially or totally open water contribute to (are side2 parent of) the Xgrid +!! and conversely +!! OCN grid cells that are totally ice covered do not contribute to (are kicked out of) the Xgrid. +!! This makes xmap a dynamical object and a powerful tool for flux exchange calculations. +!! +!! Things to keep in mind about xmap/xgrid: +!! xgrid contains two sides: +!! side1: This is the side where 2d arrays are put to and get from the Xgrid +!! side2: This is the side where 3d arrays are put to and get from the Xgrid. +!! This was designed to enable exchange along sub-grid-scale (3rd dimension) for component models that have +!! subgrid scale parametrization (e.g., seaice categories and land tiles). +!! @param[inout] xmap exchange grid +!! subroutine regen(xmap) type (xmap_type), intent(inout) :: xmap @@ -3105,8 +3124,33 @@ subroutine regen(xmap) end subroutine regen !####################################################################### - !> @brief Changes sub-grid portion areas and/or number. +!! @details (re)sets the "fraction area" of the side 2 component grid cell. +!! "fraction area" is a dynamic property of the component model (seaice or land) +!! that needs to be updated after each timestep of that component in order for the exhange mechanism to work properly. +!! The input is a 3d array of numbers between 0 and 1. It signifies the +!! fraction of the component grid cell area which has a model-specific property. +!! This property is used for some sub-grid scale parametrization in the component model. +!! E.g., for the seaice component model, the quantity of seaice in each grid cell (i,j) +!! is distibuted into N=grid%km partitions (ice categories) each parametrized with a weight (part_size) that add to 1. +!! E.g., for 6+2 thickness (h) categories used in GFDL seaice models we have +!! given hlim(1, ..., 8) = [1.0e-10, 0.1, 0.3, 0.7, 1.1, 1.5, 2.0, 2.5] (meters) +!! Caterory n=1 : h <= hlim(1), essentially no ice +!! Caterory n=2...7 : hlim(n-1) < h <= hlim(n) +!! Caterory n=8 : hlim(n-1) < h , unlimimitted ice thickness +!! E.g., if seaice in grid cell (i,j) is parameterized as +!! 10 % open water, 0% category 1, 40% category 2 , 50% category 3 then we have +!! f(i,j,1:km) = part_size(i,j,1:8) = [0.1, 0.0, 0.4, 0.5, 0.0, 0.0, 0.0, 0.0] +!! +!! @param[in] f real(r8_kind) 3D array +!! @param[in] grid_id 3 character grid ID +!! @param[inout] xmap exchange grid +!! +!!
Example usage: +!! @code{.F90} +!! call fms_xgrid_set_frac_area (Ice%part_size(isc:iec,jsc:jec,:) , 'OCN', xmap_sfc) +!! @endcode +!! subroutine set_frac_area_sg(f, grid_id, xmap) real(r8_kind), dimension(:,:,:), intent(in) :: f !< fraction area to be set character(len=3), intent(in) :: grid_id !< 3 character grid ID @@ -3284,7 +3328,7 @@ subroutine put_side2_to_xgrid(d, grid_id, x, xmap) if (grid_id==xmap%grids(1)%id) & call error_mesg ('xgrid_mod', & - 'put_to_xgrid expects a 2D side 1 grid', FATAL) + 'put_side2_to_xgrid expects a 3D side 2 grid', FATAL) do g=2,size(xmap%grids(:)) if (grid_id==xmap%grids(g)%id) then From a08691b3b57596a4b24f8a58447fda500441b709 Mon Sep 17 00:00:00 2001 From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> Date: Mon, 22 Jan 2024 10:19:15 -0500 Subject: [PATCH 05/10] fix: improve the performance in nearest_index (#1445) --- axis_utils/include/axis_utils2.inc | 86 ++++++++++++------------- test_fms/axis_utils/test_axis_utils.F90 | 21 ++++-- 2 files changed, 56 insertions(+), 51 deletions(-) diff --git a/axis_utils/include/axis_utils2.inc b/axis_utils/include/axis_utils2.inc index bac9251e0..e9e612036 100644 --- a/axis_utils/include/axis_utils2.inc +++ b/axis_utils/include/axis_utils2.inc @@ -306,64 +306,62 @@ integer :: ia !< dimension of "array" integer :: i !< For looping through "array" + logical :: increasing !< .True. if the array is increasing + ia = SIZE(array(:)) - ! check if array is monotonous + ! check if array is increasing + increasing = .true. DO i = 2, ia-1 - IF( (array(i-1)array(i+1)) .OR. (array(i-1)>array(i).AND.array(i)array NOT monotonously ordered - CALL mpp_error(FATAL, 'axis_utils2::nearest_index array is NOT monotonously ordered') - END IF + IF( array(i) .lt. array(i-1)) then + increasing = .false. + exit + endif END DO - if (array(1) < array(ia)) then - !< increasing array + if (.not. increasing) then + ! if not increasing, check that it is decreasing + DO i = 2, ia-1 + IF( array(i) .gt. array(i-1)) & + call mpp_error(FATAL, 'axis_utils2::nearest_index array is NOT monotonously ordered') + END DO + endif + array_is_increasing: if (increasing) then !< Check if the rval is outside the range of the array - if (rval < array(1)) then - NEAREST_INDEX_ = 1 - return - elseif (rval > array(ia)) then - NEAREST_INDEX_ = ia - return + if (rval .le. array(1)) then + NEAREST_INDEX_ = 1 + return + elseif (rval .ge. array(ia)) then + NEAREST_INDEX_ = ia + return endif - DO i = 1, ia-1 - IF ( (array(i)<=rval).AND.(array(i+1)>= rval) ) THEN - IF( rval - array(i) <= array(i+1) - rval ) THEN - NEAREST_INDEX_ = i - return - ELSE - NEAREST_INDEX_ = i+1 - return - ENDIF - EXIT - END IF + DO i = 2, ia + if (rval .le. array(i)) then + NEAREST_INDEX_ = i + if (array(i) -rval .gt. rval - array(i-1)) NEAREST_INDEX_ = i - 1 + return + endif END DO - else - !< Decreasing Array - + else !array_is_decreasing !< Check if the rval is outside the range of the array - if (rval < array(ia)) then - NEAREST_INDEX_ = ia - return - elseif (rval > array(1)) then - NEAREST_INDEX_ = 1 - return + if (rval .le. array(ia)) then + NEAREST_INDEX_ = ia + return + elseif (rval .gt. array(1)) then + NEAREST_INDEX_ = 1 + return endif - DO i = 1, ia-1 - IF ( (array(i)>=rval).AND.(array(i+1)<= rval) ) THEN - IF ( array(i)-rval <= rval-array(i+1) ) THEN - NEAREST_INDEX_ = i - return - ELSE - NEAREST_INDEX_ = i+1 - return - END IF - END IF + DO i = 2, ia + if (rval .ge. array(i)) then + NEAREST_INDEX_ = i + if (rval - array(i) .gt. array(i-1) -rval ) NEAREST_INDEX_ = i - 1 + return + endif END DO - endif + endif array_is_increasing end function NEAREST_INDEX_ !############################################################################# diff --git a/test_fms/axis_utils/test_axis_utils.F90 b/test_fms/axis_utils/test_axis_utils.F90 index c86d2ee4c..6304bac60 100644 --- a/test_fms/axis_utils/test_axis_utils.F90 +++ b/test_fms/axis_utils/test_axis_utils.F90 @@ -395,19 +395,19 @@ subroutine test_frac_index_fail subroutine test_nearest_index(increasing_array) logical, intent(in) :: increasing_array !< .True. if test using an increasing array - real(k) :: arr(5) - integer :: ans(12) + real(k) :: arr(7) + integer :: ans(16) if (increasing_array) then - arr = [5._k, 12._k, 20._k, 40._k, 100._k] - ans=(/1, 5, 1, 2, 3, 4, 5, 1, 2, 2, 3, 3/) + arr = [-6._k, -3._k, 5._k, 12._k, 20._k, 40._k, 100._k] + ans=(/1, 7, 3, 4, 5, 6, 7, 3, 4, 4, 5, 5, 1, 2, 1, 2/) else - arr = [100._k, 40._k, 20._k, 12._k, 5._k] - ans=(/5, 1, 5, 4, 3, 2, 1, 5, 4, 4, 3, 3/) + arr = [100._k, 40._k, 20._k, 12._k, 5._k, -3._k, -6._k] + ans=(/7, 1, 5, 4, 3, 2, 1, 5, 4, 4, 3, 3, 7, 6, 7, 6/) endif ! Test values beyond array boundaries - call nearest_index_assert(4._k, arr, ans(1)) + call nearest_index_assert(-7._k, arr, ans(1)) call nearest_index_assert(1000._k, arr, ans(2)) ! Test values actually in the array @@ -423,6 +423,13 @@ subroutine test_nearest_index(increasing_array) call nearest_index_assert(15._k, arr, ans(10)) call nearest_index_assert(18._k, arr, ans(11)) call nearest_index_assert(29._k, arr, ans(12)) + + ! Test the negative numbers + call nearest_index_assert(-6._k, arr, ans(13)) + call nearest_index_assert(-3._k, arr, ans(14)) + call nearest_index_assert(-5._k, arr, ans(15)) + call nearest_index_assert(-1._k, arr, ans(16)) + end subroutine subroutine nearest_index_assert(val, arr, ret_expected) From 63528d609b7d060a4f07a53f26943029eb0a7f9a Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Mon, 12 Feb 2024 15:33:21 -0500 Subject: [PATCH 06/10] fix: CI updates and bug fixes for CMake build (#1437) --- .github/workflows/github_cmake_gnu.yml | 18 ++++++++++++++++-- CMakeLists.txt | 7 +++++-- cmake/Findlibyaml.cmake | 4 ++-- 3 files changed, 23 insertions(+), 6 deletions(-) diff --git a/.github/workflows/github_cmake_gnu.yml b/.github/workflows/github_cmake_gnu.yml index 08fed288c..b8ee629ab 100644 --- a/.github/workflows/github_cmake_gnu.yml +++ b/.github/workflows/github_cmake_gnu.yml @@ -16,13 +16,27 @@ jobs: libyaml-flag: [ "", -DWITH_YAML=on ] io-flag: [ "", -DUSE_DEPRECATED_IO=on ] container: - image: noaagfdl/hpc-me.ubuntu-minimal:cmake + image: ghcr.io/noaa-gfdl/fms/fms-ci-rocky-gnu:12.3.0 + credentials: + username: ${{ github.actor }} + password: ${{ secrets.github_token }} env: CMAKE_FLAGS: "${{ matrix.omp-flags }} ${{ matrix.io-flag }} ${{ matrix.libyaml-flag }} -D64BIT=on" steps: - name: Checkout code uses: actions/checkout@v4 - name: Generate makefiles with CMake - run: cmake $CMAKE_FLAGS . + run: cmake $CMAKE_FLAGS -DNetCDF_ROOT=/opt/view -DLIBYAML_ROOT=/opt/view - name: Build the library run: make + - name: Link with basic executable + run: | + echo "program test" > test.F90 + echo " use fms_mod" >> test.F90 + echo " call fms_init" >> test.F90 + echo " call fms_end" >> test.F90 + echo "end program" >> test.F90 + mpifort -L/opt/view/lib -fopenmp `nf-config --flibs` -Iinclude_r4 -Iinclude_r8 test.F90 libfms_r4.a libfms_r8.a -o test.x + touch input.nml + - name: Run executable + run: ./test.x diff --git a/CMakeLists.txt b/CMakeLists.txt index 759e6a199..4756560ae 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -345,9 +345,12 @@ foreach(kind ${kinds}) target_link_libraries(${libTgt}_f PRIVATE OpenMP::OpenMP_Fortran) endif() - # Check if gnu 10 or higher with mpich + # Check if gnu 10 or higher + # this should only be needed with mpich, but wasn't able to find a good way to find the MPI flavor consistently if ( CMAKE_Fortran_COMPILER_VERSION MATCHES "1[0-9]\.[0-9]*\.[0-9]*" AND CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - if(MPI_C_COMPILER MATCHES ".*mpich.*" ) + include(CheckFortranCompilerFlag) + check_fortran_compiler_flag("-fallow-argument-mismatch" _arg_mismatch_flag) + if(_arg_mismatch_flag) message(STATUS "Adding -fallow-argument-mismatch flag to compile with GCC >=10 and MPICH") target_compile_options(${libTgt}_f PRIVATE "-fallow-argument-mismatch;-w") endif() diff --git a/cmake/Findlibyaml.cmake b/cmake/Findlibyaml.cmake index ce4b1f6c3..029447c70 100644 --- a/cmake/Findlibyaml.cmake +++ b/cmake/Findlibyaml.cmake @@ -3,8 +3,8 @@ # LIBYAML_INCLUDE_DIR # LIBYAML_LIBRARIES -FIND_PATH(LIBYAML_INCLUDE_DIR NAMES yaml.h PATHS $ENV{LIBYAML_ROOT}/include ) -FIND_LIBRARY(LIBYAML_LIBRARIES NAMES yaml PATHS $ENV{LIBYAML_ROOT}/lib ) +FIND_PATH(LIBYAML_INCLUDE_DIR NAMES yaml.h PATHS ${LIBYAML_ROOT}/include $ENV{LIBYAML_ROOT}/include ) +FIND_LIBRARY(LIBYAML_LIBRARIES NAMES yaml PATHS ${LIBYAML_ROOT}/lib $ENV{LIBYAML_ROOT}/lib ) if(NOT LIBYAML_INCLUDE_DIR OR NOT LIBYAML_LIBRARIES) message(SEND_ERROR "libyaml library/include file not found, set LIBYAML_ROOT") endif() From 82fbf0edb02ee154148cbe15640cc3c6274ba7f9 Mon Sep 17 00:00:00 2001 From: Rusty Benson <6594772+bensonr@users.noreply.github.com> Date: Thu, 22 Feb 2024 10:15:34 -0500 Subject: [PATCH 07/10] feat: make sub-communicators available for broadcasts and other uses such as MPI parallel I/O (#1457) --- mpp/include/mpp_domains_define.inc | 26 +++++++++++++++++--------- mpp/include/mpp_domains_util.inc | 19 +++++++++++++++++++ mpp/include/mpp_util.inc | 9 ++++++--- mpp/mpp.F90 | 10 +++++++++- mpp/mpp_domains.F90 | 17 ++++++++++------- 5 files changed, 61 insertions(+), 20 deletions(-) diff --git a/mpp/include/mpp_domains_define.inc b/mpp/include/mpp_domains_define.inc index b606aa3d2..e447544dc 100644 --- a/mpp/include/mpp_domains_define.inc +++ b/mpp/include/mpp_domains_define.inc @@ -644,7 +644,7 @@ integer :: i, j, m, n, xhalosz, yhalosz, memory_xsize, memory_ysize integer :: whalosz, ehalosz, shalosz, nhalosz - integer :: ipos, jpos, pos, tile, nlist, cur_tile_id + integer :: ipos, jpos, pos, tile, nlist, cur_tile_id, cur_comm_id integer :: ndivx, ndivy, isg, ieg, jsg, jeg, ishift, jshift, errunit, logunit integer :: x_offset, y_offset, start_pos, nfold logical :: from_mosaic, is_complete @@ -684,20 +684,22 @@ cur_tile_id = 1 if(present(tile_id)) cur_tile_id = tile_id + cur_comm_id=0 if( PRESENT(pelist) )then allocate( pes(0:size(pelist(:))-1) ) pes = pelist if(from_mosaic) then allocate( pesall(0:mpp_npes()-1) ) - call mpp_get_current_pelist(pesall) + call mpp_get_current_pelist(pesall, commID=cur_comm_id) else allocate( pesall(0:size(pes(:))-1) ) pesall = pes + call mpp_get_current_pelist(pesall, commID=cur_comm_id) end if else allocate( pes(0:mpp_npes()-1) ) allocate( pesall(0:mpp_npes()-1) ) - call mpp_get_current_pelist(pes) + call mpp_get_current_pelist(pes, commID=cur_comm_id) pesall = pes end if @@ -795,13 +797,14 @@ allocate(domain%tile_id_all(1)) domain%tile_id = cur_tile_id domain%tile_id_all = cur_tile_id + domain%tile_comm_id = cur_comm_id domain%ntiles = 1 domain%max_ntile_pe = 1 domain%ncontacts = 0 domain%rotated_ninety = .FALSE. allocate( domain%list(0:nlist-1) ) do i = 0, nlist-1 - allocate( domain%list(i)%x(1), domain%list(i)%y(1), domain%list(i)%tile_id(1) ) + allocate( domain%list(i)%x(1), domain%list(i)%y(1), domain%list(i)%tile_id(1)) end do end if @@ -853,6 +856,7 @@ if( ANY(pes == mpp_pe()) ) then domain%io_layout = layout domain%tile_root_pe = pes(0) + domain%comm_id = cur_comm_id if( ipos.EQ.NULL_PE .OR. jpos.EQ.NULL_PE ) & call mpp_error( FATAL, 'MPP_DEFINE_DOMAINS2D: pelist must include this PE for '//trim(domain%name) ) if( debug ) then @@ -1257,9 +1261,8 @@ end subroutine check_message_size if( nlist .NE. size(pelist(:))) call mpp_error(FATAL, & 'mpp_domains_define.inc: size of pelist is not equal mpp_npes') pes = pelist - else - call mpp_get_current_pelist(pes) end if + call mpp_get_current_pelist(pes, commID=domain%comm_id) !--- pelist should be monotonic increasing by 1. do n = 1, nlist-1 if(pes(n) - pes(n-1) .NE. 1) call mpp_error(FATAL, & @@ -1332,11 +1335,11 @@ end subroutine check_message_size do n = 0, nlist-1 nt = ntile_per_pe(n) - allocate(domain%list(n)%x(nt), domain%list(n)%y(nt), domain%list(n)%tile_id(nt) ) + allocate(domain%list(n)%x(nt), domain%list(n)%y(nt), domain%list(n)%tile_id(nt)) end do - pe = mpp_pe() pos = 0 + pe = mpp_pe() if( PRESENT(tile_id) ) then if(size(tile_id(:)) .NE. num_tile) then call mpp_error(FATAL, "mpp_domains_define.inc: size(tile_id) .NE. num_tile") @@ -1380,6 +1383,7 @@ end subroutine check_message_size allocate(tile_count(pes(0):pes(0)+nlist-1)) tile_count = 0 ! tile number on current pe + domain%tile_comm_id=0 do n = 1, num_tile allocate(mask(layout(1,n), layout(2,n))) allocate(pelist_tile(pe_start(n):pe_end(n)) ) @@ -1387,6 +1391,10 @@ end subroutine check_message_size do m = pe_start(n), pe_end(n) pelist_tile(m) = m end do + !--- set the tile communicator + if (ANY(pelist_tile == pe)) then + call mpp_declare_pelist(pelist_tile, commID=domain%tile_comm_id) + endif mask = .TRUE. if(present(maskmap)) mask = maskmap(1:layout(1,n), 1:layout(2,n), n) ndivx = layout(1,n); ndivy = layout(2,n) @@ -1451,7 +1459,7 @@ end subroutine check_message_size deallocate(mask, xext, yext, pelist_tile) end do - deallocate(pes, tile_count) + deallocate(pes, tile_count, tile_id_local) if(num_contact == 0 .OR. num_tile == 1) return diff --git a/mpp/include/mpp_domains_util.inc b/mpp/include/mpp_domains_util.inc index a8210895e..ab2933e13 100644 --- a/mpp/include/mpp_domains_util.inc +++ b/mpp/include/mpp_domains_util.inc @@ -689,6 +689,25 @@ function mpp_get_domain_tile_root_pe(domain) end function mpp_get_domain_tile_root_pe + +function mpp_get_domain_tile_commid(domain) + type(domain2d), intent(in) :: domain !> domain you are querying for information + integer :: mpp_get_domain_tile_commid !> declaration of the return tile communicator + + mpp_get_domain_tile_commid = domain%tile_comm_id + +end function mpp_get_domain_tile_commid + + +function mpp_get_domain_commid(domain) + type(domain2d), intent(in) :: domain !> domain you are querying for information + integer :: mpp_get_domain_commid !> declaration of the return domain communicator + + mpp_get_domain_commid = domain%comm_id + +end function mpp_get_domain_commid + + function mpp_get_io_domain(domain) type(domain2d), intent(in) :: domain type(domain2d), pointer :: mpp_get_io_domain diff --git a/mpp/include/mpp_util.inc b/mpp/include/mpp_util.inc index e6af1ba15..f8458806e 100644 --- a/mpp/include/mpp_util.inc +++ b/mpp/include/mpp_util.inc @@ -428,15 +428,18 @@ end function rarray_to_char !! !! This call implies synchronization across the PEs in the current !! pelist, of which pelist is a subset. - subroutine mpp_declare_pelist( pelist, name ) - integer, intent(in) :: pelist(:) - character(len=*), intent(in), optional :: name + subroutine mpp_declare_pelist( pelist, name, commID ) + integer, intent(in) :: pelist(:) !> pelist you are declaring and storing within FMS + character(len=*), intent(in), optional :: name !> unique name for an input pelist + integer, intent(out), optional :: commID !> return of current MPI comm group communicator ID integer :: i if( .NOT.module_is_initialized )call mpp_error( FATAL, 'MPP_DECLARE_PELIST: You must first call mpp_init.' ) i = get_peset(pelist) write( peset(i)%name,'(a,i2.2)' ) 'PElist', i !default name if( PRESENT(name) )peset(i)%name = name + if( PRESENT(commID) )commID = peset(i)%id + return end subroutine mpp_declare_pelist diff --git a/mpp/mpp.F90 b/mpp/mpp.F90 index 7d07e1937..b045ce6d7 100644 --- a/mpp/mpp.F90 +++ b/mpp/mpp.F90 @@ -196,7 +196,7 @@ module mpp_mod public :: COMM_TAG_9, COMM_TAG_10, COMM_TAG_11, COMM_TAG_12 public :: COMM_TAG_13, COMM_TAG_14, COMM_TAG_15, COMM_TAG_16 public :: COMM_TAG_17, COMM_TAG_18, COMM_TAG_19, COMM_TAG_20 - public :: MPP_FILL_INT,MPP_FILL_DOUBLE + public :: MPP_FILL_INT,MPP_FILL_DOUBLE,MPP_INFO_NULL public :: mpp_init_test_full_init, mpp_init_test_init_true_only, mpp_init_test_peset_allocated public :: mpp_init_test_clocks_init, mpp_init_test_datatype_list_init, mpp_init_test_logfile_init public :: mpp_init_test_read_namelist, mpp_init_test_etc_unit, mpp_init_test_requests_allocated @@ -1325,6 +1325,14 @@ module mpp_mod integer, parameter :: mpp_init_test_etc_unit = 6 integer, parameter :: mpp_init_test_requests_allocated = 7 +!> MPP_INFO_NULL acts as an analagous mpp-macro for MPI_INFO_NULL to share with fms2_io NetCDF4 +!! mpi-io. The default value for the no-mpi case comes from Intel MPI and MPICH. OpenMPI sets +!! a default value of '0' +#if defined(use_libMPI) + integer, parameter :: MPP_INFO_NULL = MPI_INFO_NULL +#else + integer, parameter :: MPP_INFO_NULL = 469762048 +#endif !*********************************************************************** ! variables needed for subroutine read_input_nml (include/mpp_util.inc) diff --git a/mpp/mpp_domains.F90 b/mpp/mpp_domains.F90 index e46f424e3..cac3cf3c1 100644 --- a/mpp/mpp_domains.F90 +++ b/mpp/mpp_domains.F90 @@ -158,6 +158,7 @@ module mpp_domains_mod public :: mpp_get_tile_npes, mpp_get_domain_root_pe, mpp_get_tile_pelist, mpp_get_tile_compute_domains public :: mpp_get_num_overlap, mpp_get_overlap public :: mpp_get_io_domain, mpp_get_domain_pe, mpp_get_domain_tile_root_pe + public :: mpp_get_domain_tile_commid, mpp_get_domain_commid public :: mpp_get_domain_name, mpp_get_io_domain_layout public :: mpp_copy_domain, mpp_set_domain_symmetry public :: mpp_get_update_pelist, mpp_get_update_size @@ -305,8 +306,8 @@ module mpp_domains_mod !> @ingroup mpp_domains_mod type :: domain2D_spec private - type(domain1D_spec), pointer :: x(:) => NULL() !< x-direction domain decomposition - type(domain1D_spec), pointer :: y(:) => NULL() !< y-direction domain decomposition + type(domain1D_spec), pointer :: x(:) => NULL() !< x-direction domain decomposition + type(domain1D_spec), pointer :: y(:) => NULL() !< y-direction domain decomposition integer, pointer :: tile_id(:) => NULL() !< tile id of each tile integer :: pe !< PE to which this domain is assigned integer :: pos !< position of this PE within link list @@ -374,13 +375,15 @@ module mpp_domains_mod integer :: whalo, ehalo !< halo size in x-direction integer :: shalo, nhalo !< halo size in y-direction integer :: ntiles !< number of tiles within mosaic + integer :: comm_id !< MPI communicator for the mosaic + integer :: tile_comm_id !< MPI communicator for this tile of domain integer :: max_ntile_pe !< maximum value in the pelist of number of tiles on each pe. - integer :: ncontacts !< number of contact region within mosaic. - logical :: rotated_ninety !< indicate if any contact rotate NINETY or MINUS_NINETY + integer :: ncontacts !< number of contact region within mosaic. + logical :: rotated_ninety !< indicate if any contact rotate NINETY or MINUS_NINETY logical :: initialized=.FALSE. !< indicate if the overlapping is computed or not. - integer :: tile_root_pe !< root pe of current tile. - integer :: io_layout(2) !< io_layout, will be set through mpp_define_io_domain - !! default = domain layout + integer :: tile_root_pe !< root pe of current tile. + integer :: io_layout(2) !< io_layout, will be set through mpp_define_io_domain + !! default = domain layout integer, pointer :: pearray(:,:) => NULL() !< pe of each layout position integer, pointer :: tile_id(:) => NULL() !< tile id of each tile on current processor integer, pointer :: tile_id_all(:)=> NULL() !< tile id of all the tiles of domain From 5300c3214be510cbc16752fe9b9eabbb4fd683bb Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Thu, 22 Feb 2024 10:17:27 -0500 Subject: [PATCH 08/10] fix: autotools check for HDF5 floating point exceptions (#1455) --- configure.ac | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/configure.ac b/configure.ac index 223733b9f..cd6449372 100644 --- a/configure.ac +++ b/configure.ac @@ -259,6 +259,21 @@ GX_FC_CHECK_MOD([netcdf], [], [], [AC_MSG_ERROR([Can't find the netCDF Fortran m GX_FORTRAN_SEARCH_LIBS([nf90_create], [netcdff], [use netcdf], [iret = nf90_create('foo.nc', 1, ncid)], [], [AC_MSG_ERROR([Can't find the netCDF Fortran library. Set LDFLAGS/LIBS])]) +# Check if we get a floating point exception with netcdf +# this will only get triggered if you have FPE traps enabled via FCFLAGS +AC_MSG_CHECKING([if HDF5 version causes floating point exceptions with set flags]) +AC_RUN_IFELSE([AC_LANG_PROGRAM([], [[ + use netcdf + integer i, j + j = nf90_open("test.nc", NC_WRITE, i) +]])], [hdf5_fpe_bug=no], [hdf5_fpe_bug=yes]) +AC_MSG_RESULT([$hdf5_fpe_bug]) +if test $hdf5_fpe_bug = yes; then + AC_MSG_ERROR([The HDF5 version used to build netcdf is incompatible with the set FCFLAGS. dnl +NetCDF must be built with a HDF5 version other than 1.14.3 to support floating point exception traps.]) +fi + + # Check if Fortran compiler has the Class, Character array assign bug GX_FC_CLASS_CHAR_ARRAY_BUG_CHECK() From 1d3570d6c83ef79f0ce2639cc114fa0076d94ee5 Mon Sep 17 00:00:00 2001 From: Ray Menzel <43218622+menzel-gfdl@users.noreply.github.com> Date: Thu, 7 Mar 2024 11:16:10 -0500 Subject: [PATCH 09/10] Fix : Make interpolator File Path Buffer Bigger (#1469) --- interpolator/include/interpolator.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpolator/include/interpolator.inc b/interpolator/include/interpolator.inc index 96bd7d76a..7f3226041 100644 --- a/interpolator/include/interpolator.inc +++ b/interpolator/include/interpolator.inc @@ -127,7 +127,7 @@ integer , intent(in), optional :: vert_interp(:) character(len=*), intent(out), optional :: clim_units(:) logical, intent(out), optional :: single_year_file -character(len=64) :: src_file +character(len=128) :: src_file !++lwh real(FMS_INTP_KIND_) :: dlat, dlon !--lwh From 1bb706cc61f8351f176e4f9b7ccc8ab25ed6999b Mon Sep 17 00:00:00 2001 From: Scitech777 <160655680+Scitech777@users.noreply.github.com> Date: Thu, 7 Mar 2024 12:33:39 -0500 Subject: [PATCH 10/10] chore: add Molly to the code owners file(#1474) --- .github/CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index db81ffb9a..ff4da7503 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -25,7 +25,7 @@ # These owners will be the default owners for all the files in the # repository. Unless a later match is found, these owners # will be requested for a review when a PR is opened. -* @thomas-robinson @bensonr @rem1776 +* @thomas-robinson @bensonr @rem1776 @scitech777 # GNU autotools files Makefile.am @uramirez8707 @rem1776