diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index ad15989475..5cd5f91baa 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -19,12 +19,18 @@ jobs: - uses: ./.github/actions/testing-setup - - name: Compile unit testing - run: make -j build/unit/MOM_unit_tests + - name: Compile file parser unit tests + run: make -j build/unit/test_MOM_file_parser - - name: Run unit tests + - name: Run file parser unit tests run: make run.cov.unit + - name: Compile unit testing + run: make -j build.unit + + - name: Run (single processor) unit tests + run: make run.unit + - name: Report unit test coverage to CI (PR) if: github.event_name == 'pull_request' run: make report.cov.unit REQUIRE_COVERAGE_UPLOAD=true diff --git a/.github/workflows/perfmon.yml b/.github/workflows/perfmon.yml index 09b4d617a2..76140c9469 100644 --- a/.github/workflows/perfmon.yml +++ b/.github/workflows/perfmon.yml @@ -1,6 +1,6 @@ name: Performance Monitor -on: [pull_request] +on: [push, pull_request] jobs: build-test-perfmon: @@ -20,6 +20,7 @@ jobs: - uses: ./.github/actions/testing-setup - name: Compile optimized models + if: ${{ github.event_name == 'pull_request' }} run: >- make -j build.prof MOM_TARGET_SLUG=$GITHUB_REPOSITORY @@ -27,12 +28,26 @@ jobs: DO_REGRESSION_TESTS=true - name: Generate profile data + if: ${{ github.event_name == 'pull_request' }} run: >- pip install f90nml && make profile DO_REGRESSION_TESTS=true - name: Generate perf data + if: ${{ github.event_name == 'pull_request' }} run: | sudo sysctl -w kernel.perf_event_paranoid=2 make perf DO_REGRESSION_TESTS=true + + - name: Compile timing tests + run: | + make -j build.timing + + - name: Run timing tests + run: | + make -j run.timing + + - name: Display timing results + run: | + make -j show.timing diff --git a/.testing/Makefile b/.testing/Makefile index 6afda40a38..aabe51c8b6 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -116,6 +116,9 @@ DO_PROFILE ?= # Enable code coverage runs DO_COVERAGE ?= +# Enable code coverage runs +DO_UNIT_TESTS ?= + # Report failure if coverage report is not uploaded REQUIRE_COVERAGE_UPLOAD ?= @@ -151,10 +154,16 @@ ifeq ($(DO_PROFILE), true) BUILDS += opt/MOM6 opt_target/MOM6 endif -# Unit testing -UNIT_EXECS ?= MOM_unit_tests +# Coverage ifeq ($(DO_COVERAGE), true) - BUILDS += cov/MOM6 $(foreach e, $(UNIT_EXECS), unit/$(e)) + BUILDS += cov/MOM6 +endif + +# Unit testing (or coverage) +UNIT_EXECS ?= $(basename $(notdir $(wildcard ../config_src/drivers/unit_tests/*.F90) ) ) +TIMING_EXECS ?= $(basename $(notdir $(wildcard ../config_src/drivers/timing_tests/*.F90) ) ) +ifneq (X$(DO_COVERAGE)$(DO_UNIT_TESTS)X, XX) + BUILDS += $(foreach e, $(UNIT_EXECS), unit/$(e)) endif ifeq ($(DO_PROFILE), false) @@ -258,6 +267,7 @@ build/coupled/Makefile: MOM_ENV += $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) build/nuopc/Makefile: MOM_ENV += $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) build/cov/Makefile: MOM_ENV += $(COV_FCFLAGS) $(COV_LDFLAGS) build/unit/Makefile: MOM_ENV += $(COV_FCFLAGS) $(COV_LDFLAGS) +build/timing/Makefile: MOM_ENV += $(OPT_FCFLAGS) $(MOM_LDFLAGS) # Configure script flags MOM_ACFLAGS := --with-framework=$(FRAMEWORK) @@ -265,6 +275,7 @@ build/openmp/Makefile: MOM_ACFLAGS += --enable-openmp build/coupled/Makefile: MOM_ACFLAGS += --with-driver=FMS_cap build/nuopc/Makefile: MOM_ACFLAGS += --with-driver=nuopc_cap build/unit/Makefile: MOM_ACFLAGS += --with-driver=unit_tests +build/timing/Makefile: MOM_ACFLAGS += --with-driver=timing_tests # Fetch regression target source code build/target/Makefile: | $(TARGET_CODEBASE) @@ -276,10 +287,15 @@ build/target_codebase/configure: $(TARGET_SOURCE) # Build executables -$(foreach e,$(UNIT_EXECS),build/unit/$(e)): build/unit/Makefile $(MOM_SOURCE) - cd $(@D) && $(TIME) $(MAKE) -j -build/%/MOM6: build/%/Makefile $(MOM_SOURCE) - cd $(@D) && $(TIME) $(MAKE) -j +build/unit/test_%: build/unit/Makefile FORCE + cd $(@D) && $(TIME) $(MAKE) $(@F) -j +build/unit/Makefile: $(foreach e,$(UNIT_EXECS),../config_src/drivers/unit_tests/$(e).F90) +build/timing/time_%: build/timing/Makefile FORCE + cd $(@D) && $(TIME) $(MAKE) $(@F) -j +build/timing/Makefile: $(foreach e,$(TIMING_EXECS),../config_src/drivers/timing_tests/$(e).F90) +build/%/MOM6: build/%/Makefile FORCE + cd $(@D) && $(TIME) $(MAKE) $(@F) -j +FORCE: ; # Use autoconf to construct the Makefile for each target @@ -655,28 +671,47 @@ test.summary: .PHONY: run.cov.unit run.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov -$(WORKSPACE)/work/unit/std.out: build/unit/MOM_unit_tests +.PHONY: build.unit +build.unit: $(foreach f, $(UNIT_EXECS), build/unit/$(f)) +.PHONY: run.unit +run.unit: $(foreach f, $(UNIT_EXECS), work/unit/$(f).out) +.PHONY: build.timing +build.timing: $(foreach f, $(TIMING_EXECS), build/timing/$(f)) +.PHONY: run.timing +run.timing: $(foreach f, $(TIMING_EXECS), work/timing/$(f).out) +.PHONY: show.timing +show.timing: $(foreach f, $(TIMING_EXECS), work/timing/$(f).show) +$(WORKSPACE)/work/timing/%.show: + ./tools/disp_timing.py $(@:.show=.out) + +# General rule to run a unit test executable +# Pattern is to run build/unit/executable and direct output to executable.out +$(WORKSPACE)/work/unit/%.out: build/unit/% + @mkdir -p $(@D) + cd $(@D) ; $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> >(tee $*.err) > $*.out + +$(WORKSPACE)/work/unit/test_MOM_file_parser.out: build/unit/test_MOM_file_parser if [ $(REPORT_COVERAGE) ]; then \ find build/unit -name *.gcda -exec rm -f '{}' \; ; \ fi - rm -rf $(@D) mkdir -p $(@D) cd $(@D) \ - && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std.err > std.out \ + && rm -f input.nml logfile.0000*.out *_input MOM_parameter_doc.* \ + && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> test_MOM_file_parser.err > test_MOM_file_parser.out \ || !( \ - cat std.out | tail -n 100 ; \ - cat std.err | tail -n 100 ; \ + cat test_MOM_file_parser.out | tail -n 100 ; \ + cat test_MOM_file_parser.err | tail -n 100 ; \ ) cd $(@D) \ - && $(TIME) $(MPIRUN) -n 2 $(abspath $<) 2> p2.std.err > p2.std.out \ + && $(TIME) $(MPIRUN) -n 2 $(abspath $<) 2> p2.test_MOM_file_parser.err > p2.test_MOM_file_parser.out \ || !( \ - cat p2.std.out | tail -n 100 ; \ - cat p2.std.err | tail -n 100 ; \ + cat p2.test_MOM_file_parser.out | tail -n 100 ; \ + cat p2.test_MOM_file_parser.err | tail -n 100 ; \ ) # NOTE: .gcov actually depends on .gcda, but .gcda is produced with std.out # TODO: Replace $(WORKSPACE)/work/unit/std.out with *.gcda? -build/unit/MOM_file_parser_tests.F90.gcov: $(WORKSPACE)/work/unit/std.out +build/unit/MOM_file_parser_tests.F90.gcov: $(WORKSPACE)/work/unit/test_MOM_file_parser.out cd $(@D) \ && gcov -b *.gcda > gcov.unit.out find $(@D) -name "*.gcov" -exec sed -i -r 's/^( *[0-9]*)\*:/ \1:/g' {} \; @@ -693,6 +728,10 @@ report.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov codecov if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ } +$(WORKSPACE)/work/timing/%.out: build/timing/% FORCE + @mkdir -p $(@D) + @echo Running $< in $(@D) + @cd $(@D) ; $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> $*.err > $*.out #--- # Profiling based on FMS clocks diff --git a/.testing/README.rst b/.testing/README.rst index 5bab076707..49103da718 100644 --- a/.testing/README.rst +++ b/.testing/README.rst @@ -22,6 +22,17 @@ Usage ``make clean`` Delete the MOM6 test executables and dependency builds (FMS). +``make -j build.unit`` + Build the unit test programs in config_src/drivers/unit_tests + +``make -j run.unit`` + Run the unit test programs from config_src/drivers/unit_tests in $(WORKSPACE)/work/unit + +``make -j build.timing`` + Build the timing test programs in config_src/drivers/timing_tests + +``make -j run.timing`` + Run the timing test programs from config_src/drivers/timing_tests in $(WORKSPACE)/work/timing Configuration ============= diff --git a/.testing/tools/disp_timing.py b/.testing/tools/disp_timing.py new file mode 100755 index 0000000000..ac90ef2b55 --- /dev/null +++ b/.testing/tools/disp_timing.py @@ -0,0 +1,133 @@ +#!/usr/bin/env python3 + +from __future__ import print_function + +import argparse +import json +import math + +scale = 1e6 # micro-seconds (should make this dynamic) + + +def display_timing_file(file, show_all): + """Parse a JSON file of timing results and pretty-print the results""" + + with open(file) as json_file: + timing_dict = json.load(json_file) + + print("(Times measured in %5.0e seconds)" % (1./scale)) + print(" Min time Module & function") + for sub in timing_dict.keys(): + tmin = timing_dict[sub]['min'] * scale + print("%10.4e %s" % (tmin, sub)) + + if show_all: + tmean = timing_dict[sub]['mean'] * scale + tmax = timing_dict[sub]['max'] * scale + tstd = timing_dict[sub]['std'] * scale + nsamp = timing_dict[sub]['n_samples'] + tsstd = tstd / math.sqrt(nsamp) + print(" (" + + "mean = %10.4e " % (tmean) + + "±%7.1e, " % (tsstd) + + "max = %10.4e, " % (tmax) + + "std = %8.2e, " % (tstd) + + "# = %d)" % (nsamp)) + + +def compare_timing_files(file, ref, show_all, significance_threshold): + """Read and compare two JSON files of timing results""" + + with open(file) as json_file: + timing_dict = json.load(json_file) + + with open(ref) as json_file: + ref_dict = json.load(json_file) + + print("(Times measured in %5.0e seconds)" % (1./scale)) + print(" Delta (%) Module & function") + for sub in {**ref_dict, **timing_dict}.keys(): + T1 = ref_dict.get(sub) + T2 = timing_dict.get(sub) + if T1 is not None: + # stats for reference (old) + tmin1 = T1['min'] * scale + tmean1 = T1['mean'] * scale + if T2 is not None: + # stats for reference (old) + tmin2 = T2['min'] * scale + tmean2 = T2['mean'] * scale + if (T1 is not None) and (T2 is not None): + # change in actual minimum as percentage of old + dt = (tmin2 - tmin1) * 100 / tmin1 + if dt < -significance_threshold: + color = '\033[92m' + elif dt > significance_threshold: + color = '\033[91m' + else: + color = '' + print("%s%+10.4f%%\033[0m %s" % (color, dt, sub)) + else: + if T2 is None: + print(" removed %s" % (sub)) + else: + print(" added %s" % (sub)) + + if show_all: + if T2 is None: + print(" --") + else: + tmax2 = T2['max'] * scale + tstd2 = T2['std'] * scale + n2 = T2['n_samples'] + tsstd2 = tstd2 / math.sqrt(n2) + print(" %10.4e (" % (tmin2) + + "mean = %10.4e " % (tmean2) + + "±%7.1e, " % (tsstd2) + + "max=%10.4e, " % (tmax2) + + "std=%8.2e, " % (tstd2) + + "# = %d)" % (n2)) + if T1 is None: + print(" --") + else: + tmax1 = T1['max'] * scale + tstd1 = T1['std'] * scale + n1 = T1['n_samples'] + tsstd1 = tstd1 / math.sqrt(n1) + print(" %10.4e (" % (tmin1) + + "mean = %10.4e " % (tmean1) + + "±%7.1e, " % (tsstd1) + + "max=%10.4e, " % (tmax1) + + "std=%8.2e, " % (tstd1) + + "# = %d)" % (n1)) + + +# Parse arguments +parser = argparse.ArgumentParser( + description="Beautify timing output from MOM6 timing tests." +) +parser.add_argument( + 'file', + help="File to process." +) +parser.add_argument( + '-a', '--all', + action='store_true', + help="Display all metrics rather than just the minimum time." +) +parser.add_argument( + '-t', '--threshold', + default=6.0, type=float, + help="Significance threshold to flag (percentage)." +) +parser.add_argument( + '-r', '--reference', + help="Reference file to compare against." +) +args = parser.parse_args() + +# Do the thing +if args.reference is None: + display_timing_file(args.file, args.all) +else: + compare_timing_files(args.file, args.reference, args.all, args.threshold) diff --git a/config_src/drivers/timing_tests/time_MOM_EOS.F90 b/config_src/drivers/timing_tests/time_MOM_EOS.F90 new file mode 100644 index 0000000000..29bd4a30ab --- /dev/null +++ b/config_src/drivers/timing_tests/time_MOM_EOS.F90 @@ -0,0 +1,206 @@ +program time_MOM_EOS + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_EOS, only : EOS_type +use MOM_EOS, only : EOS_manual_init +use MOM_EOS, only : calculate_density, calculate_spec_vol +use MOM_EOS, only : list_of_eos, get_EOS_name + +implicit none + +! This macro is used to write out timings of a single test rather than conduct +! a suite of tests. It is not meant for general consumption. +#undef PDF_ONLY + +integer, parameter :: n_fns = 4 +character(len=40) :: fn_labels(n_fns) + +! Testing parameters: +! nic is number of elements to compute density for (array size), per call +! halo is data on either end of the array that should not be used +! nits is how many times to repeat the call between turning the timer on/off +! to overcome limited resolution of the timer +! nsamp repeats the timing to collect statistics on the measurement +#ifdef PDF_ONLY +integer, parameter :: nic=26, halo=4, nits=10000, nsamp=400 +#else +integer, parameter :: nic=23, halo=4, nits=1000, nsamp=400 +#endif + +real :: times(nsamp) ! For observing the PDF + +! Arrays to hold timings: +! first axis corresponds to the form of EOS +! second axis corresponds to the function being timed +real, dimension(:,:), allocatable :: timings, tmean, tstd, tmin, tmax +integer :: n_eos, i, j + +n_eos = size(list_of_eos) +allocate( timings(n_eos,n_fns), tmean(n_eos,n_fns) ) +allocate( tstd(n_eos,n_fns), tmin(n_eos,n_fns), tmax(n_eos,n_fns) ) + +fn_labels(1) = 'calculate_density_scalar()' +fn_labels(2) = 'calculate_density_array()' +fn_labels(3) = 'calculate_spec_vol_scalar()' +fn_labels(4) = 'calculate_spec_vol_array()' + +tmean(:,:) = 0. +tstd(:,:) = 0. +tmin(:,:) = 1.e9 +tmax(:,:) = 0. +do i = 1, nsamp +#ifdef PDF_ONLY + call run_one(list_of_EOS, nic, halo, nits, times(i)) +#else + call run_suite(list_of_EOS, nic, halo, nits, timings) + tmean(:,:) = tmean(:,:) + timings(:,:) + tstd(:,:) = tstd(:,:) + timings(:,:)**2 ! tstd contains sum or squares here + tmin(:,:) = min( tmin(:,:), timings(:,:) ) + tmax(:,:) = max( tmax(:,:), timings(:,:) ) +#endif +enddo +tmean(:,:) = tmean(:,:) / real(nsamp) +tstd(:,:) = tstd(:,:) / real(nsamp) ! convert to mean of squares +tstd(:,:) = tstd(:,:) - tmean(:,:)**2 ! convert to variance +tstd(:,:) = sqrt( tstd(:,:) * ( real(nsamp) / real(nsamp-1) ) ) ! Standard deviation + +#ifdef PDF_ONLY +open(newunit=i, file='times.txt', status='replace', action='write') +write(i,'(1pE9.3)') times(:) +close(i) +#else + +! Display results in YAML +write(*,'(a)') "{" +do i = 1, n_eos + do j = 1, n_fns + write(*,"(2x,5a)") '"MOM_EOS_', trim(get_EOS_name(list_of_EOS(i))), & + ' ', trim(fn_labels(j)), '": {' + write(*,"(4x,a,1pe11.4,',')") '"min": ',tmin(i,j) + write(*,"(4x,a,1pe11.4,',')") '"mean":',tmean(i,j) + write(*,"(4x,a,1pe11.4,',')") '"std": ',tstd(i,j) + write(*,"(4x,a,i7,',')") '"n_samples": ',nsamp + if (i*j.ne.n_eos*n_fns) then + write(*,"(4x,a,1pe11.4,'},')") '"max": ',tmax(i,j) + else + write(*,"(4x,a,1pe11.4,'}')") '"max": ',tmax(i,j) + endif + enddo +enddo +write(*,'(a)') "}" +#endif + +contains + +subroutine run_suite(EOS_list, nic, halo, nits, timings) + integer, intent(in) :: EOS_list(n_eos) !< IDs of EOS forms to loop over + integer, intent(in) :: nic !< Width of computational domain + integer, intent(in) :: halo !< Width of halo to add on either end + integer, intent(in) :: nits !< Number of calls to sample + !! (large enough that the CPU timers can resolve + !! the loop) + real, intent(out) :: timings(n_eos,n_fns) !< The average time taken for nits calls + !! First index corresponds to EOS + !! Second index: 1 = scalar args, + !! 2 = array args without halo, + !! 3 = array args with halo and "dom". + type(EOS_type) :: EOS + integer :: e, i, dom(2) + real :: start, finish, T, S, P, rho + real, dimension(nic+2*halo) :: T1, S1, P1, rho1 + + T = 10. + S = 35. + P = 2000.e4 + + ! Time the scalar interface + do e = 1, n_eos + call EOS_manual_init(EOS, form_of_EOS=EOS_list(e), & + Rho_T0_S0=1030., dRho_dT=0.2, dRho_dS=-0.7) + + call cpu_time(start) + do i = 1, nits*nic ! Calling nic* to make similar cost to array call + call calculate_density(T, S, P, rho, EOS) + enddo + call cpu_time(finish) + timings(e,1) = (finish - start) / real(nits) + + call cpu_time(start) + do i = 1, nits*nic ! Calling nic* to make similar cost to array call + call calculate_spec_vol(T, S, P, rho, EOS) + enddo + call cpu_time(finish) + timings(e,2) = (finish - start) / real(nits) + + enddo + + ! Time the "dom" interface, 1D array + halos + T1(:) = T + S1(:) = S + P1(:) = P + dom(:) = [1+halo,nic+halo] + + do e = 1, n_eos + call EOS_manual_init(EOS, form_of_EOS=EOS_list(e), & + Rho_T0_S0=1030., dRho_dT=0.2, dRho_dS=-0.7) + + call cpu_time(start) + do i = 1, nits + call calculate_density(T1, S1, P1, rho1, EOS, dom) + enddo + call cpu_time(finish) + timings(e,3) = (finish - start) / real(nits) + + call cpu_time(start) + do i = 1, nits + call calculate_spec_vol(T1, S1, P1, rho1, EOS, dom) + enddo + call cpu_time(finish) + timings(e,4) = (finish - start) / real(nits) + + enddo + +end subroutine run_suite + +!> Return timing for just one fixed call to explore the PDF +subroutine run_one(EOS_list, nic, halo, nits, timing) + integer, intent(in) :: EOS_list(n_eos) !< IDs of EOS forms to loop over + integer, intent(in) :: nic !< Width of computational domain + integer, intent(in) :: halo !< Width of halo to add on either end + integer, intent(in) :: nits !< Number of calls to sample + !! (large enough that the CPU timers can resolve + !! the loop) + real, intent(out) :: timing !< The average time taken for nits calls + !! First index corresponds to EOS + !! Second index: 1 = scalar args, + !! 2 = array args without halo, + !! 3 = array args with halo and "dom". + type(EOS_type) :: EOS + integer :: i, dom(2) + real :: start, finish + real, dimension(nic+2*halo) :: T1, S1, P1, rho1 + + ! Time the scalar interface + call EOS_manual_init(EOS, form_of_EOS=EOS_list(5), & + Rho_T0_S0=1030., dRho_dT=0.2, dRho_dS=-0.7) + + ! Time the "dom" interface, 1D array + halos + T1(:) = 10. + S1(:) = 35. + P1(:) = 2000.e4 + dom(:) = [1+halo,nic+halo] + + call EOS_manual_init(EOS, form_of_EOS=EOS_list(5), & + Rho_T0_S0=1030., dRho_dT=0.2, dRho_dS=-0.7) + + call cpu_time(start) + do i = 1, nits + call calculate_density(T1, S1, P1, rho1, EOS, dom) + enddo + call cpu_time(finish) + timing = (finish-start)/real(nits) + +end subroutine run_one + +end program time_MOM_EOS diff --git a/config_src/drivers/unit_tests/test_MOM_EOS.F90 b/config_src/drivers/unit_tests/test_MOM_EOS.F90 new file mode 100644 index 0000000000..070bec04f6 --- /dev/null +++ b/config_src/drivers/unit_tests/test_MOM_EOS.F90 @@ -0,0 +1,10 @@ +program test_MOM_EOS + +use MOM_EOS, only : EOS_unit_tests +use MOM_error_handler, only : set_skip_mpi + +call set_skip_mpi(.true.) ! This unit tests is not expecting MPI to be used + +if ( EOS_unit_tests(.true.) ) stop 1 + +end program test_MOM_EOS diff --git a/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 b/config_src/drivers/unit_tests/test_MOM_file_parser.F90 similarity index 96% rename from config_src/drivers/unit_tests/MOM_unit_test_driver.F90 rename to config_src/drivers/unit_tests/test_MOM_file_parser.F90 index eafa8fa722..55f57d5fc2 100644 --- a/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 +++ b/config_src/drivers/unit_tests/test_MOM_file_parser.F90 @@ -1,4 +1,4 @@ -program MOM_unit_tests +program test_MOM_file_parser use MPI use MOM_domains, only : MOM_infra_init @@ -62,4 +62,4 @@ program MOM_unit_tests close(io_unit, status='delete') endif -end program MOM_unit_tests +end program test_MOM_file_parser diff --git a/config_src/drivers/unit_tests/test_MOM_mixedlayer_restrat.F90 b/config_src/drivers/unit_tests/test_MOM_mixedlayer_restrat.F90 new file mode 100644 index 0000000000..3e5eec64fc --- /dev/null +++ b/config_src/drivers/unit_tests/test_MOM_mixedlayer_restrat.F90 @@ -0,0 +1,10 @@ +program test_MOM_mixedlayer_restrat + +use MOM_mixed_layer_restrat, only : mixedlayer_restrat_unit_tests +use MOM_error_handler, only : set_skip_mpi + +call set_skip_mpi(.true.) ! This unit tests is not expecting MPI to be used + +if ( mixedlayer_restrat_unit_tests(.true.) ) stop 1 + +end program test_MOM_mixedlayer_restrat diff --git a/config_src/drivers/unit_tests/test_MOM_string_functions.F90 b/config_src/drivers/unit_tests/test_MOM_string_functions.F90 new file mode 100644 index 0000000000..2376afbbae --- /dev/null +++ b/config_src/drivers/unit_tests/test_MOM_string_functions.F90 @@ -0,0 +1,10 @@ +program test_MOM_string_functions + +use MOM_string_functions, only : string_functions_unit_tests +use MOM_error_handler, only : set_skip_mpi + +call set_skip_mpi(.true.) ! This unit tests is not expecting MPI to be used + +if ( string_functions_unit_tests(.true.) ) stop 1 + +end program test_MOM_string_functions diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index c68dc7b661..2087cd86e5 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -84,6 +84,7 @@ module MOM_EOS public gsw_sp_from_sr public gsw_pt_from_ct public query_compressible +public get_EOS_name ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -181,6 +182,10 @@ module MOM_EOS integer, parameter, public :: EOS_ROQUET_RHO = 7 !< A named integer specifying an equation of state integer, parameter, public :: EOS_ROQUET_SPV = 8 !< A named integer specifying an equation of state integer, parameter, public :: EOS_JACKETT06 = 9 !< A named integer specifying an equation of state +!> A list of all the available EOS +integer, dimension(9), public :: list_of_EOS = (/ EOS_LINEAR, EOS_UNESCO, & + EOS_WRIGHT, EOS_WRIGHT_FULL, EOS_WRIGHT_REDUCED, & + EOS_TEOS10, EOS_ROQUET_RHO, EOS_ROQUET_SPV, EOS_JACKETT06 /) character*(12), parameter :: EOS_LINEAR_STRING = "LINEAR" !< A string for specifying the equation of state character*(12), parameter :: EOS_UNESCO_STRING = "UNESCO" !< A string for specifying the equation of state @@ -1679,6 +1684,36 @@ logical function query_compressible(EOS) query_compressible = EOS%compressible end function query_compressible +!> Returns the string identifying the equation of state with enumeration "id" +function get_EOS_name(id) result (eos_name) + integer, optional, intent(in) :: id !< Enumerated ID + character(:), allocatable :: eos_name !< The name of the EOS + + select case (id) + case (EOS_LINEAR) + eos_name = EOS_LINEAR_STRING + case (EOS_UNESCO) + eos_name = EOS_UNESCO_STRING + case (EOS_WRIGHT) + eos_name = EOS_WRIGHT_STRING + case (EOS_WRIGHT_REDUCED) + eos_name = EOS_WRIGHT_RED_STRING + case (EOS_WRIGHT_FULL) + eos_name = EOS_WRIGHT_FULL_STRING + case (EOS_TEOS10) + eos_name = EOS_TEOS10_STRING + case (EOS_ROQUET_RHO) + eos_name = EOS_ROQUET_RHO_STRING + case (EOS_ROQUET_SPV) + eos_name = EOS_ROQUET_SPV_STRING + case (EOS_JACKETT06) + eos_name = EOS_JACKETT06_STRING + case default + call MOM_error(FATAL, "get_EOS_name: something went wrong internally - enumeration is not valid.") + end select + +end function get_EOS_name + !> Initializes EOS_type by allocating and reading parameters. The scaling factors in !! US are stored in EOS for later use. subroutine EOS_init(param_file, EOS, US) @@ -2249,7 +2284,11 @@ logical function EOS_unit_tests(verbose) if (verbose .and. fail) call MOM_error(WARNING, "TEOS_POLY TFr has failed some self-consistency tests.") EOS_unit_tests = EOS_unit_tests .or. fail - if (verbose .and. .not.EOS_unit_tests) call MOM_mesg("All EOS consistency tests have passed.") + if (EOS_unit_tests) then + call MOM_error(WARNING, "EOS_unit_tests: One or more EOS tests have failed!") + else + if (verbose) call MOM_mesg("EOS_unit_tests: All EOS consistency tests have passed.") + endif end function EOS_unit_tests diff --git a/src/framework/MOM_error_handler.F90 b/src/framework/MOM_error_handler.F90 index d61e82b32c..b113050572 100644 --- a/src/framework/MOM_error_handler.F90 +++ b/src/framework/MOM_error_handler.F90 @@ -10,6 +10,11 @@ module MOM_error_handler use posix, only : sigjmp_buf, siglongjmp use posix, only : sleep +! MOM_error_infra does not provide stderr . We only use stderr in this module +! *IF* FMS has not been initialized. Further, stderr is only used internally and +! not made public. Other modules should obtain stderr from MOM_io. +use iso_fortran_env, only : stderr=>error_unit + implicit none ; private ! These routines are found in this module. @@ -20,7 +25,7 @@ module MOM_error_handler public :: is_root_pe, stdlog, stdout !> Integer parameters encoding the severity of an error message public :: NOTE, WARNING, FATAL -public :: disable_fatal_errors, enable_fatal_errors +public :: disable_fatal_errors, enable_fatal_errors, set_skip_mpi integer :: verbosity = 6 !< Verbosity level: @@ -58,6 +63,11 @@ module MOM_error_handler !< The default signal handler used before signal() setup (usually SIG_DFT) type(sigjmp_buf) :: prior_env !< Buffer containing the program state to be recovered by longjmp +logical :: skip_mpi_dep = .false. + !< If true, bypass any calls that require FMS (MPI) to have been initialized. + !! Use s/r set_skip_mpi() to change this flag. By default, set_skip_mpi() does not + !! need to be called and this flag is false so that FMS (and MPI) should be + !! initialized. contains @@ -72,11 +82,15 @@ subroutine MOM_mesg(message, verb, all_print) integer :: verb_msg logical :: write_msg - write_msg = is_root_pe() + if (skip_mpi_dep) then + write_msg = .true. + else + write_msg = is_root_pe() + endif if (present(all_print)) write_msg = write_msg .or. all_print verb_msg = 2 ; if (present(verb)) verb_msg = verb - if (write_msg .and. (verbosity >= verb_msg)) call MOM_err(NOTE, message) + if (write_msg .and. (verbosity >= verb_msg)) call loc_MOM_err(NOTE, message) end subroutine MOM_mesg @@ -121,6 +135,14 @@ subroutine enable_fatal_errors() dummy => signal(sig, prior_handler) end subroutine enable_fatal_errors +!> Enable/disable skipping MPI dependent behaviors +subroutine set_skip_mpi(skip) + logical, intent(in) :: skip !< State to assign + + skip_mpi_dep = skip + +end subroutine set_skip_mpi + !> This provides a convenient interface for writing an error message !! with run-time filter based on a verbosity and the severity of the error. subroutine MOM_error(level, message, all_print) @@ -128,19 +150,21 @@ subroutine MOM_error(level, message, all_print) character(len=*), intent(in) :: message !< A message to write out logical, optional, intent(in) :: all_print !< If present and true, any PEs are !! able to write this message. - ! This provides a convenient interface for writing an error message - ! with run-time filter based on a verbosity. logical :: write_msg integer :: rc - write_msg = is_root_pe() + if (skip_mpi_dep) then + write_msg = .true. + else + write_msg = is_root_pe() + endif if (present(all_print)) write_msg = write_msg .or. all_print select case (level) case (NOTE) - if (write_msg.and.verbosity>=2) call MOM_err(NOTE, message) + if (write_msg.and.verbosity>=2) call loc_MOM_err(NOTE, message) case (WARNING) - if (write_msg.and.verbosity>=1) call MOM_err(WARNING, message) + if (write_msg.and.verbosity>=1) call loc_MOM_err(WARNING, message) case (FATAL) if (ignore_fatal) then print *, "(FATAL): " // message @@ -151,12 +175,33 @@ subroutine MOM_error(level, message, all_print) ! In practice, the signal will take control before sleep() completes. rc = sleep(3) endif - if (verbosity>=0) call MOM_err(FATAL, message) + if (verbosity>=0) call loc_MOM_err(FATAL, message) case default - call MOM_err(level, message) + call loc_MOM_err(level, message) end select end subroutine MOM_error +!> A private routine through which all error/warning/note messages are written +!! by this module. +subroutine loc_MOM_err(level, message) + integer, intent(in) :: level !< The severity level of this message + character(len=*), intent(in) :: message !< A message to write out + + if (.not. skip_mpi_dep) then + call MOM_err(level, message) + else + ! FMS (and therefore MPI) have not been initialized + write(stdout(),'(a)') trim(message) ! Send message to stdout + select case (level) + case (WARNING) + write(stderr,'("WARNING ",a)') trim(message) ! Additionally send message to stderr + case (FATAL) + write(stderr,'("ERROR: ",a)') trim(message) ! Additionally send message to stderr + end select + endif + +end subroutine loc_MOM_err + !> This subroutine sets the level of verbosity filtering MOM error messages subroutine MOM_set_verbosity(verb) integer, intent(in) :: verb !< A level of verbosity to set @@ -202,10 +247,10 @@ subroutine callTree_enter(mesg,n) nAsString = '' if (present(n)) then write(nAsString(1:8),'(i8)') n - call MOM_err(NOTE, 'callTree: '// & + call loc_MOM_err(NOTE, 'callTree: '// & repeat(' ',callTreeIndentLevel-1)//'loop '//trim(mesg)//trim(nAsString)) else - call MOM_err(NOTE, 'callTree: '// & + call loc_MOM_err(NOTE, 'callTree: '// & repeat(' ',callTreeIndentLevel-1)//'---> '//trim(mesg)) endif endif @@ -217,7 +262,7 @@ subroutine callTree_leave(mesg) if (callTreeIndentLevel<1) write(0,*) 'callTree_leave: error callTreeIndentLevel=',callTreeIndentLevel,trim(mesg) callTreeIndentLevel = callTreeIndentLevel - 1 if (verbosity<6) return - if (is_root_pe()) call MOM_err(NOTE, 'callTree: '// & + if (is_root_pe()) call loc_MOM_err(NOTE, 'callTree: '// & repeat(' ',callTreeIndentLevel)//'<--- '//trim(mesg)) end subroutine callTree_leave @@ -233,10 +278,10 @@ subroutine callTree_waypoint(mesg,n) nAsString = '' if (present(n)) then write(nAsString(1:8),'(i8)') n - call MOM_err(NOTE, 'callTree: '// & + call loc_MOM_err(NOTE, 'callTree: '// & repeat(' ',callTreeIndentLevel)//'loop '//trim(mesg)//trim(nAsString)) else - call MOM_err(NOTE, 'callTree: '// & + call loc_MOM_err(NOTE, 'callTree: '// & repeat(' ',callTreeIndentLevel)//'o '//trim(mesg)) endif endif diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 1f73653aa3..e21c33beaf 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -1794,6 +1794,8 @@ subroutine mixedlayer_restrat_register_restarts(HI, GV, US, param_file, CS, rest end subroutine mixedlayer_restrat_register_restarts +!> Returns true if a unit test of functions in MOM_mixedlayer_restrat fail. +!! Returns false otherwise. logical function mixedlayer_restrat_unit_tests(verbose) logical, intent(in) :: verbose !< If true, write results to stdout ! Local variables